home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / fweb140x.zip / ftangle.c.changed < prev    next >
Text File  |  1996-02-26  |  170KB  |  8,604 lines
  1. #if(0)
  2.   FTANGLE v1.40, created with UNIX on "Saturday, October 30, 1993 at 13:10."  \
  3.   COMMAND LINE: "web/ftangle web/ftangle -A -# --F -= 1.40/web/ftangle.c" \
  4.   RUN TIME: "Saturday, October 30, 1993 at 13:15." \
  5.   WEB FILE:    "web/ftangle.web" \
  6.   CHANGE FILE: (none)
  7. #endif
  8. #define _FTANGLE_h  
  9. #define _FWEB_h   \
  10.  
  11. #define semi  01 /* Kludge! */ \
  12.  
  13. #define SILENT  (boolean)NO
  14. #define COMPLAIN  (boolean)YES \
  15.  
  16. #define OUTER_MACRO  0xFF
  17. #define OUTER_UNMACRO  0xFE
  18. #define UNDEFINED_MACRO  0xFD \
  19.  
  20. #define MAX_XLEVELS  200 \
  21.  
  22. #define equiv  equiv_or_xref /* Info corresponding to names. */
  23. #define EQUIV  ASCII HUGE*/* For casting into the above field. */ \
  24.  \
  25. /* Note that the following function retrieves not only regular \WEB\  \
  26. macros, but also built-in functions. */
  27. #define MAC_LOOKUP(cur_val)(cur_val<MODULE_NAME? \
  28. (text_pointer)(name_dir+(cur_val))->equiv:NULL) \
  29.  
  30. #define macro  0 /* For appending a macro; distinguishes from a module. */ \
  31.  \
  32.  \
  33. /* The following are the values of the |macro_type| field of  \
  34. |name_pointer|s. */
  35. #define NOT_DEFINED  0
  36. #define DEFERRED_MACRO  1 /* Numbers chosen so that |DEFERRED_MACRO +  \
  37.     scanning_defn| gives the two choices. */
  38. #define IMMEDIATE_MACRO  2
  39. #define FILE_NAME  3 /* Used to prevent truncations from affecting file names. */ \
  40.  
  41. #define MAKE_RECURSIVE  052 /* To allow a WEB macro to be recursive, preface its  \
  42.     definition by this symbol, as in `\.{@m *R R}'.  (Recursive macros  \
  43.     are not presently implemented.) */ \
  44.  
  45. #define AUTO_INSERT  0133
  46. #define END_AUTO_INSERT  0135 \
  47.  \
  48. /* Guard against overflow of the macro buffer. */
  49. #define MCHECK(n,reason)if(mp+(n)>macrobuf_end) \
  50. mbuf_full((unsigned long)(n),(outer_char*)reason) \
  51.  
  52. #define RST_LAST_EXPR  {plast_char= last_char;last_xpr_overflowed= NO;} \
  53.  
  54. #define INDENT_SIZE  2 /* Number of columns to indent for each level of  \
  55. beautified Ratfor output. (Put into style file?) */ \
  56.  
  57. #define NO_INDENT  0
  58. #define INDENT  2 \
  59.  
  60. #define OUT_FILE  outp_file[lan_num(out_language)]/* Output of \FTANGLE. */ \
  61.  \
  62. /* The next may not be used. */
  63. #define C_printf(c,a) \
  64. { \
  65. if(!out_file)open_out(OC(""),YES); \
  66. if(fprintf(out_file,c,a)<0)out_error(OC("fprintf")); \
  67. } \
  68.  
  69. #define NOT_CONTINUATION  0
  70. #define CONTINUATION  1 \
  71.  
  72. #define N_STRBUF  150 \
  73.  
  74. #define send_new_line  RST_LAST_EXPR flush0();PUTC('\n') \
  75.  
  76. #define NEWLINE_TO_FORTRAN(continuation_flag) \
  77. flush_out(YES);/* Write out the buffer. */ \
  78. rst_out(continuation_flag)/* Reinitialize the buffer with no  \
  79. continuation character. */ \
  80.  
  81. #define TO_BUFFER(type) \
  82. if(!nuweb_mode) \
  83. { \
  84. px= t_style.meta[lan_num(language)].msg.type; \
  85. STRCPY(outp_buf,px); \
  86. out_pos= STRLEN(px); \
  87. } \
  88.  
  89. #define CUR_BUF  (pai->text_buf[pai->ilevel]) \
  90.  
  91. #define module_flag  (sixteen_bits)max_texts /* Final |text_link| in module  \
  92.                         replacement texts. */ \
  93.  
  94. #define cur_end  cur_state.end_field /* Current ending location in |tok_mem|. */
  95. #define cur_byte  cur_state.byte_field /* Location of next output byte in |tok_mem|. */
  96. #define cur_name  cur_state.name_field /* Pointer to current name being expanded. */
  97. #define cur_repl  cur_state.repl_field /* Pointer to current replacement text. */
  98. #define cur_mod  cur_state.mod_field /* Current module number being expanded. */ \
  99.  
  100. #define cur_language  cur_state.language /* Current language. */
  101. #define cur_global_language  cur_state.global_params.Language \
  102. /* Global language for this level. */ \
  103.  \
  104. /* Current flags. */
  105. #define cur_params  cur_state.params /*  Local flags. */
  106. #define cur_global_params  cur_state.global_params /*  Global flags. */ \
  107.  \
  108. /* Current macro buffer params. */
  109. #define macrobuf  cur_state.macro_buf
  110. #define macrobuf_end  cur_state.macro_buf_end \
  111.  
  112. #define UNNAMED_MODULE  0 \
  113.  
  114. #define UNNAMED_MOD  "unnamed"
  115. #define flush_buffer()C_putc('\n') \
  116.  
  117. #define NEWLINE  puts("") \
  118.  
  119. #define BP_MARKER  1 \
  120.  
  121. #define PROPER_END(end) \
  122. end= (np+1)->byte_start; \
  123. if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
  124.  
  125. #define MAX_ID_LENGTH  32 /* Truncated identifiers can't be longer than this. */ \
  126.  
  127. #define GLOBAL_SCOPE  YES
  128. #define LOCAL_SCOPE  NO \
  129.  
  130. #define CHECK_OPEN  if(!out_file)open_out(OC(""),GLOBAL_SCOPE) \
  131.  
  132. #define OUT_OP(s)out_op(OC(s))
  133. #define OUT_STR(s)out_str(OC(s)) \
  134.  
  135. #define F_OP(op77,op88)(Fortran88?op88:op77) \
  136.  
  137. #define stringg  (eight_bits)02 /* Extended ASCII alpha should not appear. (The funny  \
  138.     spelling is to avoid conflict with the VAX' \.{stdlib}.) */
  139. #define constant  (eight_bits)03 /* Numerical constant. */
  140. #define begin_Xmeta  or_or
  141. #define end_Xmeta  star_star
  142. #define cdir  (eight_bits)06 /* Brackets compiler directive.. */
  143. #define colon_colon  (eight_bits)011 /* \Cpp\ and \Fortran--90: `$\CF$'. */ \
  144.  
  145. #define join  (eight_bits)0177 /* |ASCII| delete will not appear. */ \
  146.  
  147. #define ID0  0200 /* End of the 7-bit ASCII codes. */
  148. #define TOKEN1(a)((a)<ID0)/* Is |a|~a single-byte token? */ \
  149.  
  150. #define MACRO_ARGUMENT  0377 /* See the related definition and discussion of  \
  151.                 |MOD0|. */
  152. #define BASE2  0400 /* |0xFF + 1 = 0x100 = 256| */ \
  153.  
  154. #define MODULE_NAME  10240 /* |024000= 10240 = (0250-0200)*0400| */
  155. #define MODULE_NUM  20480 /* |050000 = 20480 = (0320-0200)*0400| */
  156. #define LINE_NUM  53248L /* |0150000==0320*0400| */ \
  157.  
  158. #define IDENTIFIER(left,right)(((left)-ID0)*BASE2+(right))/* Construct  \
  159.                 two-byte token out of its constituents. */ \
  160.  
  161. #define LEFT(a,id)((eight_bits)(((a)/BASE2+(id))))/* Make left-hand byte out of  \
  162.                     |sixteen_bits|. */
  163. #define RIGHT(a)((eight_bits)(((a)%BASE2)))/* Make right-hand byte. */ \
  164.  
  165. #define ignore  0 /* Control code of no interest to \.{TANGLE}. */ \
  166.  
  167. #define begin_comment0  (eight_bits)0376 /* Sent from |input_ln|; marker for long comment. */
  168. #define begin_comment1  (eight_bits)0375 /* As above; marker for short comment. */ \
  169.  
  170. #define module_number  (eight_bits)0201 /* Code returned by |get_output| for mod.\ numbers. */
  171. #define identifier  (eight_bits)0202 /* Code returned by |get_output| for identifiers. */
  172. #define id_keyword  (eight_bits)0203 /* As above, but for expandable keyword. */ \
  173.  
  174. #define L_switch  (eight_bits)0257 /* Control code for `\.{@L}'. */
  175. #define begin_FORTRAN  (eight_bits)0260
  176. #define begin_RATFOR  (eight_bits)0261
  177. #define begin_C  (eight_bits)0262
  178. #define begin_LITERAL  (eight_bits)0263 \
  179.  
  180. #define verbatim  (eight_bits)0264 /* Can't be~|02| as for \.{fweave}, because  \
  181.                 |stringg| is defined to be that. */ \
  182.  
  183. #define invisible_cmnt  (eight_bits)0265 /* Control code for `\.{@\%}'. */
  184. #define compiler_directive  (eight_bits)0266 /* No longer used. */
  185. #define Compiler_Directive  (eight_bits)0267 /* Control code for `\.{@?}'. */
  186. #define no_index  (eight_bits)0300 /* Control code for `\.{@-}'. */
  187. #define yes_index  (eight_bits)0301 /* Control code for `\.{@!}'. */ \
  188.  
  189. #define ascii_constant  (eight_bits)0302 /* Control code for `\.{@'}'. */
  190. #define begin_vcmnt  (eight_bits)0303 /* Control code for `\.{@\slashstar}'. */
  191. #define big_line_break  (eight_bits)0304 /* Control code for `\.{@\#}'. */ \
  192.  
  193. #define begin_bp  (eight_bits)0305
  194. #define insert_bp  (eight_bits)0306 \
  195.  
  196. #define begin_meta  (eight_bits)017 /* Control code for |"@("|. */
  197. #define end_meta  (eight_bits)027 \
  198.  
  199. #define TeX_string  (eight_bits)0307
  200. #define xref_roman  (eight_bits)0310
  201. #define xref_typewriter  (eight_bits)0311
  202. #define xref_wildcard  (eight_bits)0312 \
  203.  
  204. #define control_text  (eight_bits)0313 /* Control code for `\.{@t}', `\.{@\^}', etc. */ \
  205.  
  206. #define begin_nuweb  (eight_bits)0314
  207. #define no_mac_expand  (eight_bits)0315 /* Control code for `\.{@\~}' */ \
  208.  
  209. #define formatt  (eight_bits)0320 /* Control code for `\.{@f}'. */ \
  210.  
  211. #define limbo_text  (eight_bits)0323 /* Control code for `\.{@l}'. */
  212. #define op_def  (eight_bits)0324 /* Control code for `\.{@v}'. */
  213. #define macro_def  (eight_bits)0325 /* Control code for `\.{@W}'. */ \
  214.  
  215. #define ignore_defn  (eight_bits)0327 /* Stuff to here should be ignored when scanning defn. */ \
  216.  
  217. #define new_output_file  (eight_bits)0331 /* Control code for `\.{@o}'. */ \
  218.  
  219. #define definition  (eight_bits)0332 /* Control code for `\.{@d}'. */
  220. #define undefinition  (eight_bits)0333 /* Control code for `\.{@u}'. */
  221. #define WEB_definition  (eight_bits)0334 /* Control code for `\.{@m}'. */ \
  222.  
  223. #define m_ifdef  (eight_bits)0335
  224. #define m_ifndef  (eight_bits)0336
  225. #define m_if  (eight_bits)0337
  226. #define m_else  (eight_bits)0340
  227. #define m_elif  (eight_bits)0341
  228. #define m_endif  (eight_bits)0342
  229. #define m_for  (eight_bits)0343
  230. #define m_endfor  (eight_bits)0344
  231. #define m_pragma  (eight_bits)0345
  232. #define m_undef  (eight_bits)0346 \
  233.  
  234. #define end_of_buffer  (eight_bits)0347 \
  235.  
  236. #define begin_code  (eight_bits)0350 /* Control code for `\.{@a}'. */
  237. #define module_name  (eight_bits)0351 /* Control code for `\.{@<}'. */ \
  238.  
  239. #define new_module  (eight_bits)0352 /* Control code for `\.{@\ }' and `\.{@*}'. */ \
  240.  
  241. #define MAYBE_SET_OUTPUT(l)if(last_char!=0174)set_output_file(l) \
  242.  
  243. #define RETURN(pcode)return(eight_bits)pcode \
  244.  
  245. #define compress(c)if(loc++<=limit)return(eight_bits)(c)
  246. #define Fcompress(c)if(is_FORTRAN_(language)&&loc<limit) \
  247. return(eight_bits)(c)/* Not used. */
  248. #define STOP  (boolean)YES
  249. #define DONT_STOP  (boolean)NO \
  250.  \
  251. /* Add a token to |token_mem|. */
  252. #define app_repl(c){if(tok_ptr==tok_m_end) \
  253. OVERFLW("tokens","tt"); \
  254. *tok_ptr++= (eight_bits)(c);} \
  255.  
  256. #define BP_BUF_SIZE  (13+MAX_ID_LENGTH)/* The print command below generates a  \
  257.     string of the form ``\.{\_BP(99999,"\dots")}'', where the \dots\  \
  258.     correspond to |name_of|, whose maximum length is |MAX_ID_LENGTH|. */ \
  259.  
  260. #define N_IDBUF  100
  261. #define MAX_LEVEL  20 \
  262.  \
  263. /* We have to tell |scan_text| whether or not to expand the text it is  \
  264. reading. */
  265. #define EXPAND  YES \
  266.  
  267. #define DEF_OR_NDEF(flag) \
  268. found_else= NO; \
  269. if(!expand) \
  270. { \
  271. to_endif(m_ifdef); \
  272. goto next_macro_token; \
  273. } \
  274. else \
  275. { \
  276. text_pointer m; \
  277. if((next_control= get_next())!=identifier) \
  278. { \
  279.  \
  280. err0_print(ERR_T,OC("Expected identifier after @#ifdef  \
  281. or @#ifndef; assuming not defined"),0); \
  282. if_switch= NO; \
  283. } \
  284. else if_switch=  \
  285. BOOLEAN(flag((m= MAC_LOOKUP(ID_NUM(id_first,id_loc)))!=NULL \
  286. &&!(m->built_in))); \
  287. /* Is the identifier defined as a WEB macro? */ \
  288. if(if_switch) \
  289. { \
  290. GET_LINE;/* Skip possible comment at end of  \
  291. \.{@\#ifdef} or \.{@\#ifndef}. */ \
  292. scan_text(text_type,p,if_switch); \
  293. } \
  294. else \
  295. { \
  296. expand= NO;to_else(); \
  297.  \
  298. if(next_control!=m_endif) \
  299. { \
  300. scanned_if= YES; \
  301. goto next_macro_token; \
  302. } \
  303. else \
  304. { \
  305. next_control= ignore; \
  306. expand= YES; \
  307. GET_LINE;/* Skip possible comment after  \
  308. \.{@\#endif}. */ \
  309. break; \
  310. } \
  311. } \
  312. } \
  313.  \
  314. /* The following were changed from |TRUE| and |FALSE| to avoid difficulties  \
  315. with the VAX' \.{cc}.  */
  316. #define M_TRUE  
  317. #define M_FALSE  ! \
  318.  
  319. #define GET_LINE   \
  320. if(!from_buffer) \
  321. if(language!=TEX) \
  322. get_line() \
  323.  
  324. #define OUT_OF_ORDER(cmd)out_of_order((outer_char*)cmd) \
  325.  
  326. #define SPCS_AFTER_CMNT  1 /* For beautification of the Ratfor error messages. */ \
  327.  
  328.  
  329.  
  330.  
  331. #ifndef part
  332. #define part 0 /* Standard value, when the files aren't split. */
  333. #else
  334. #if part != 1 && part != 2 && part != 3
  335. #define part 1 /* Should issue error message here. */
  336. #endif
  337. #endif /* |part| */
  338.  
  339.  
  340.  
  341.  
  342. #if(part == 0 || part == 1)
  343. #define part1_or_extern
  344. #define SET1(stuff) =  stuff
  345. #define TSET1(stuff) =  stuff
  346. #else
  347. #define part1_or_extern extern
  348. #define SET1(stuff)
  349. #define TSET1(stuff)
  350. #endif
  351.  
  352.  
  353.  
  354.  
  355.  
  356. #include "typedefs.h"
  357.  
  358.  
  359.  
  360.  
  361.  
  362. #include "map.h" /* Relations between style file keywords and internal arrays. */
  363.  
  364.  
  365.  
  366.  
  367. /* Precedence of the various operators. */
  368. typedef enum{BAD_TOKEN,OR_OR,AND_AND,BIT_OR,BIT_XOR,BIT_AND,LOG_EQ,LOG_LT,
  369. BIT_SHIFT,PLUS_MINUS,TIMES,EXP,UNARY,HIGHEST_UNARY}PRECEDENCE;
  370.  
  371. /* An operator, together with its precedence. */
  372. typedef struct
  373. {
  374. eight_bits token;
  375. PRECEDENCE precedence;
  376. }OP;
  377.  
  378. /* The actual data value. */
  379. typedef union
  380. {
  381. long i;/* All integers are long, to humor the pc people. */
  382. double d;/* We handle just one floating-point type. */
  383. sixteen_bits id;/* An identifier token. */
  384. OP op;
  385. }VALUE;
  386.  
  387. /* Type of the data value. The relative order must be preserved here, \
  388. because it is used in the type promotion routine |promote|. */
  389. typedef enum{Int,Double,Id,Op}TYPE;
  390.  
  391. /* Complete data structure for the token; includes links to the next and \
  392. last |VAL| structures. */
  393. typedef struct val
  394. {
  395. VALUE value;/* The actual data value or operator token. */
  396. TYPE type;/* The type of value stored in |value|. */
  397. struct val HUGE*last,HUGE*next;/* Link to the last and next values. */
  398. }VAL;
  399.  
  400.  
  401. typedef struct
  402. {
  403. int token[MAX_XLEVELS];
  404. int level;
  405. }XIDS;
  406.  
  407.  
  408.  
  409. /* We'll manage the buffers with a structure.  That way, we can use a \
  410. standard routine |store| to add a byte. */
  411. typedef struct
  412. {
  413. outer_char HUGE*start,HUGE*pos,HUGE*end;
  414. }TEXT_BUF;
  415.  
  416. /* One parenthesis level is described like this. */
  417. typedef struct
  418. {
  419. int ilevel;/* Current buffer (index) level. */
  420. TEXT_BUF HUGE*text_buf[10];/* Temporary storage for the index tokens. */
  421. TEXT_BUF HUGE*last_buf;/* Buffer of the previous level. */
  422. }PAREN_LEVEL;
  423.  
  424. PAREN_LEVEL paren_level[10],HUGE*pai= paren_level;
  425.  
  426. int rparen= NO;/* Was the last character a right paren? */
  427.  
  428.  
  429.  
  430.  
  431. typedef struct
  432. {
  433. eight_bits HUGE*tok_start;/* Pointer into |tok_mem| (for a module or \
  434. regular macro).  For an internal macro, points to the internal function. */
  435. sixteen_bits text_link;/* Relates replacement texts  (0 for a macro). */
  436. boolean Language;/* Which language referenced this name. */
  437. eight_bits nargs;/* Number of macro arguments. */
  438. unsigned moffset:8,/* Offset to macro replacement text from start. */
  439. recursive:1,/* Is this macro allowed to be recursive? */
  440. var_args:1,/* Can it have variable number of arguments? */
  441. module_text:1,/* Distinguishes from preprocessor fragment. */
  442. built_in:1;/* Is it a built-in function (internal macro)? */
  443. }text;
  444.  
  445. typedef text HUGE*text_pointer;
  446.  
  447.  
  448.  
  449. typedef struct{
  450. eight_bits HUGE*end_field;/* Ending location of replacement text. */
  451. eight_bits HUGE*byte_field;/* Present location within replacement text. */
  452. name_pointer name_field;/* |byte_start| index for text being output. */
  453. text_pointer repl_field;/* |tok_start| index for text being output. */
  454. sixteen_bits mod_field;/* Module number, or zero if not a module. */
  455. PARAMS global_params,params;/* Various flags. */
  456. eight_bits HUGE*macro_buf,HUGE*macro_buf_end;/* Current macro buffer. */
  457. }output_state;
  458.  
  459. typedef output_state HUGE*stack_pointer;
  460.  
  461.  
  462.  
  463. #if(0)
  464. IN_COMMON boolean truncate_ids;/* Truncate identifers? */
  465. IN_COMMON unsigned short tr_max[];/* Truncate to this length. */
  466. IN_COMMON name_pointer npmax;/* |name_ptr - 1|. */
  467. #endif
  468.  
  469. /* Back-pointer structure points back to the original name in |name_dir|. */
  470. typedef struct Bp
  471. {
  472. ASCII c;/* Dummy byte that always remains~|BP_MARKER|. */
  473. LANGUAGE Language;
  474. CONST ASCII HUGE*byte_start,HUGE*byte_end;/* Points to original, \
  475. untruncated name. */
  476. struct Bp HUGE*next;/* Links to next back-pointer structure, in \
  477. case a truncated name came from more than one original name. */
  478. struct Trunc HUGE*Root;
  479. }BP;
  480.  
  481. /* Info about a truncated identifier. */
  482. typedef struct Trunc
  483. {
  484. boolean Language;/* All languages associated with this name. */
  485. size_t num[NUM_LANGUAGES];
  486. /* \# of instances of the truncated name. */
  487. ASCII HUGE*id,HUGE*id_end;/* Truncated variable name. */
  488. BP HUGE*first,HUGE*last;/* First and last back-pointer structures. */
  489. struct Trunc HUGE*next;/* Next structure in truncated chain. */
  490. }TRUNC;
  491.  
  492.  
  493.  
  494. #include "t_type.h" /* Function prototypes for \FTANGLE. */
  495.  
  496.  
  497.  
  498.  
  499. /* The shorter length here is primarily to keep the stack under control. \
  500. Now that |N_MSGBUF| is used  dynamically, maybe this statement isn't \
  501. necessary. */
  502. #ifdef SMALL_MEMORY
  503. #define N_MSGBUF 2000
  504. #else
  505. #define N_MSGBUF 10000
  506. #endif
  507.  
  508.  
  509.  
  510.  
  511.  
  512. IN_COMMON STMT_LBL max_stmt;/* See \.{common.web}. */
  513.  
  514. EXTERN sixteen_bits outp_line[NUM_LANGUAGES]
  515. #ifdef _FTANGLE_h
  516. #if(part == 0 || part == 1)
  517. = {1,1,1,1,1,1,1,1}
  518. #endif /* |part == 1| */
  519. #endif /* |_FTANGLE_h| */
  520. ;
  521.  
  522.  
  523.  
  524. EXTERN int indnt_size SET(INDENT_SIZE);
  525. /* So we can interface to \.{rat77.web}. */
  526.  
  527. EXTERN outer_char HUGE*last_char,HUGE*last_end;/* Dynamic array. */
  528. EXTERN outer_char HUGE*plast_char;/* Current position in |last_char|. */
  529. EXTERN BUF_SIZE max_expr_chars;/* Allocated length of |last_char|. */
  530.  
  531. EXTERN boolean last_xpr_overflowed SET(NO);
  532.  
  533. EXTERN int indent_level SET(0);/* Current state of Ratfor output. */
  534.  
  535.  
  536.  
  537. /* --- Output buffer for C --- */
  538. EXTERN outer_char HUGE*C_buffer,HUGE*pC_end;/* Dynamically allocated. */
  539. EXTERN outer_char HUGE*pC_buffer;/* Current position. */
  540. EXTERN BUF_SIZE C_buf_size;/* Length of dynamic buffer array. */
  541.  
  542. /* --- String positions in that buffer --- */
  543. EXTERN outer_char HUGE*split_pos;/* Current position. */
  544.  
  545. /* --- Output buffer for \TeX\ --- */
  546. EXTERN outer_char HUGE*X_buffer,HUGE*pX_end;/* Dynamically allocated. */
  547. EXTERN outer_char HUGE*pX_buffer;/* Current position. */
  548. EXTERN BUF_SIZE X_buf_size;/* Length of dynamic buffer array. */
  549.  
  550.  
  551.  
  552. EXTERN int rst_pos SET(0);/* The position immediately after resetting. */
  553. EXTERN int out_pos SET(0);/* Current position in \Fortran's output buffer. */
  554. EXTERN boolean in_string SET(NO);/* Faster version of the output state. */
  555. EXTERN boolean in_constant SET(NO);/* Ditto. */
  556. EXTERN boolean started_vcmnt SET(NO);
  557. EXTERN boolean meta_mode SET(NO);
  558.  
  559.  
  560.  
  561. IN_COMMON outer_char outp_buf[];/* \Fortran's output buffer. */
  562. IN_COMMON int nbuf_length;/* Maximum of above, for breaking. */
  563. EXTERN boolean out_at_beginning SET(YES);/* Flag for the output buffer. */
  564.  
  565.  
  566.  
  567. EXTERN long max_texts;/* Number of replacement texts, must be $< 10240$. */
  568. EXTERN text HUGE*text_info;/* Dynamic array. */
  569. EXTERN text_pointer text_end;/* End of above. */
  570.  
  571. EXTERN long dtexts_max;/* Number of deferred replacement texts. */
  572. EXTERN text HUGE*txt_dinfo;/* Dynamic array. */
  573. EXTERN text_pointer textd_end;
  574.  
  575. EXTERN text_pointer text_ptr,txt_dptr;/* First unused position in |text_info| \
  576.                     and in |txt_dinfo|. */
  577.  
  578. EXTERN long max_toks;/* Number of bytes in compressed code. */
  579. EXTERN eight_bits HUGE*tok_mem;/* Dynamic array. */
  580. EXTERN eight_bits HUGE*tok_m_end;
  581.  
  582. EXTERN long max_dtoks;/* Number of bytes in deferred macros. */
  583. EXTERN eight_bits HUGE*tok_dmem;/* Dynamic array. */
  584. EXTERN eight_bits HUGE*tokd_end;
  585.  
  586. EXTERN eight_bits HUGE*tok_ptr,HUGE*tok_dptr;/* First unused position in \
  587.             |tok_mem| and in |tok_dmem|. */
  588. EXTERN eight_bits HUGE*mx_tok_ptr,HUGE*mx_dtok_ptr;/* Largest value \
  589.     assumed by |tok_ptr|  and |tok_ptrd|; for statistics. */
  590.  
  591. EXTERN text_pointer macro_text;
  592.  
  593.  
  594.  
  595. EXTERN text_pointer last_unnamed;/* Most recent replacement text of \
  596.                     unnamed module. */
  597.  
  598.  
  599.  
  600. EXTERN output_state cur_state;/* |cur_end|, |cur_byte|, |cur_name|, \
  601.     |cur_repl|, |cur_mod|, |cur_global_language|, and |cur_language|. */
  602.  
  603. EXTERN long stck_size;/* Number of simultaneous levels of macro expansion. */
  604. EXTERN output_state HUGE*stack;/* Dynamic array: Info for non-current levels. */
  605. EXTERN stack_pointer stck_end;/* End of |stack|. */
  606. EXTERN stack_pointer stck_ptr;/* First unused loc.\ in the output state stack. */
  607.  
  608.  
  609. /* These harmlessly redefine stuff in \.{typedefs.web}. It's a bit shaky, but \
  610. it seems to work. One was running out of lower-order tokens. */
  611.  
  612. #undef begin_format_stmt
  613. #define begin_format_stmt (eight_bits)014
  614.  
  615. #undef end_format_stmt
  616. #define end_format_stmt (eight_bits)015
  617.  
  618. EXTERN long cur_val;/* Additional information corresponding to output \
  619.     token. This must be \It{signed} (and capable of handling a full \
  620.     |sixteen_bits|) because of trickery involving output of the module \
  621.     numbers. */
  622.  
  623.  
  624.  
  625. EXTERN eight_bits sent;
  626.  
  627.  
  628.  
  629. IN_RATFOR sixteen_bits id_function,id_program,id_subroutine;
  630.  
  631.  
  632.  
  633. EXTERN sixteen_bits cur_mod_no SET(0);
  634.  
  635.  
  636.  
  637. EXTERN OUTPUT_STATE out_state;/* Current status of partial output. */
  638. EXTERN boolean protect;/* Current status of partial output. */
  639. EXTERN boolean copying_macros SET(NO);/* Outputting outer macros? */
  640. EXTERN boolean in_cdir SET(NO);/* Inside a compiler directive? */
  641.  
  642.  
  643.  
  644. EXTERN TRUNC sh;
  645.  
  646.  
  647.  
  648. EXTERN boolean mac_protected SET(NO);/* Are we between left quotes, so macros \
  649.                 shouldn't be expanded? */
  650. EXTERN boolean send_rp SET(NO);/* Takes on a value only for |language == \
  651.     RATFOR || language==FORTRAN|, when it's used to enclose the rhs of \
  652.     an operator like \.{*=}. */
  653.  
  654. EXTERN boolean in_version SET(NO);/* For the initial header of output file. */
  655. EXTERN T_META*pmeta;
  656.  
  657.  
  658.  
  659. EXTERN OPEN_FILE HUGE*open_file,HUGE*open_file_end,HUGE*last_file;
  660. EXTERN BUF_SIZE num_files;/* Allocated length of |open_file|. */
  661.  
  662.  
  663.  
  664. EXTERN LINE_NUMBER nearest_line SET(0);
  665.  
  666.  
  667.  
  668. IN_STYLE eight_bits ccode[128];/* Meaning of a char following '\.{@}'. */
  669.  
  670.  
  671.  
  672. EXTERN boolean comment_continues SET(NO);/* Are we scanning a comment? */
  673.  
  674.  
  675.  
  676. EXTERN name_pointer cur_module SET(NULL);/* name of module just scanned */
  677. EXTERN ASCII c;/* the current character for |get_next| */
  678. EXTERN boolean strt_cmnt;
  679. EXTERN boolean strt_point_cmnt;
  680. EXTERN boolean suppress_newline;/* For scanning past invisible comments. */
  681. EXTERN boolean eat_blank_lines;/* For `\.{@\%\%}'. */
  682. EXTERN boolean no_expand SET(NO);/* For use with `\.{@\~}. */
  683.  
  684.  
  685.  
  686. EXTERN boolean starts_with_0,hex_constant,bin_constant,floating_constant;
  687.  
  688.  
  689.  
  690. EXTERN text_pointer cur_text;/* Replacement text just formed by |scan_repl|. */
  691.  
  692. EXTERN eight_bits next_control;
  693.  
  694.  
  695.  
  696. EXTERN boolean breakpoints;
  697.  
  698.  
  699.  
  700. EXTERN int n_unique SET(0);
  701. EXTERN boolean deferred_macro SET(NO);
  702.  
  703.  
  704.  
  705. EXTERN boolean is_WEB_macro SET(NO);
  706. EXTERN boolean scanning_defn;/* Deflects verbatim comments from def'n section. */
  707. EXTERN boolean scanning_TeX;/* To help out |scan_text| with the handling \
  708.                 of vertical bars. */
  709. EXTERN boolean nuweb_mode1;/* In case \.{@N} appears in defn section. */
  710.  
  711. EXTERN int mlevel SET(0);/* Level of preprocessor expansion. */
  712.  
  713.  
  714.  
  715. EXTERN boolean found_else SET(NO);
  716.  
  717.  
  718.  
  719. EXTERN sixteen_bits num_distinct_modules SET(1);/* Count the unnamed module. */
  720. EXTERN sixteen_bits num_modules;
  721.  
  722.  
  723.  
  724. #if SMALL_MEMORY
  725. #define MSG_BUF_SIZE 5000
  726. #else
  727. #define MSG_BUF_SIZE 50000L
  728. #endif
  729.  
  730.  
  731.  
  732. /* For pc's, the file is split into three compilable parts using the \
  733. compiler-line macro |part|, which must equal either~1, 2, or~3. */
  734. #if(part == 0 || part == 1)
  735.  
  736.  
  737. int main FCN((ac,av))
  738. int ac C0("Number of arguments.")
  739. outer_char**av C1("Argument list.")
  740. {
  741. ini_timer();/* Timing statistics are printed at the end of the run; see \
  742.             \.{common.web}. */
  743.  
  744. /* Remember the arguments to |main| in global variables. */
  745. argc= ac;argv= av;
  746.  
  747. ini_program(tangle);/* Set the |program| flag etc.; see \.{common.web}. */
  748.  
  749.  
  750. {
  751.  
  752. {
  753. ALLOC(OPEN_FILE,open_file,"nf",num_files,0);
  754. last_file= open_file;
  755. open_file_end= open_file+num_files;
  756. }
  757.  
  758. /* Stuff that must be used for command line. */
  759. common_init();/* Expand the command line here. */
  760.  
  761.  
  762. ALLOC(outer_char,last_char,"lx",max_expr_chars,0);
  763. last_end= last_char+max_expr_chars;
  764. plast_char= last_char;
  765.  
  766.  
  767.  
  768. /* --- Allocate C output buffer --- */
  769. ALLOC(outer_char,C_buffer,"cb",C_buf_size,0);
  770. pC_end= C_buffer+C_buf_size-1;/* Allow for extra backslash if necessary. */
  771. pC_buffer= C_buffer;/* Initialize to beginning. */
  772.  
  773. #if FANCY_SPLIT
  774.  
  775. {
  776. split_pos= C_buffer;
  777. }
  778.  
  779.  
  780. #endif /* |FANCY_SPLIT| */
  781.  
  782. /* --- Allocate \TeX\ output buffer --- */
  783. ALLOC(outer_char,X_buffer,"xb",X_buf_size,0);
  784. pX_end= X_buffer+X_buf_size;
  785. pX_buffer= X_buffer;/* Initialize to beginning. */
  786.  
  787.  
  788. {
  789. pai->ilevel= 0;
  790. pai->text_buf[0]= pai->last_buf= calloc(1,sizeof(TEXT_BUF));
  791. }
  792.  
  793.  
  794.  
  795. alloc_Rat();/* Allocate \Ratfor\ arrays. */
  796.  
  797. ALLOC(text,text_info,"x",max_texts,0);
  798. text_end= text_info+max_texts-1;
  799.  
  800. ALLOC(text,txt_dinfo,"dx",dtexts_max,0);
  801. textd_end= txt_dinfo+dtexts_max-1;
  802.  
  803. ALLOC(eight_bits,tok_mem,"tt",max_toks,0);
  804. tok_m_end= tok_mem+max_toks-1;
  805.  
  806. ALLOC(eight_bits,tok_dmem,"dt",max_dtoks,0);
  807. tokd_end= tok_dmem+max_dtoks-1;
  808.  
  809.  
  810.  
  811. ALLOC(output_state,stack,"kt",stck_size,1);
  812. stck_end= stack+stck_size;/* End of |stack|. */
  813.  
  814.  
  815. {
  816. BUF_SIZE cur_num= last_file-open_file;/* Current size of list. */
  817.  
  818. /* Obtain the new allocation size. */
  819. alloc((outer_char*)"nf",(BUF_SIZE HUGE*)&num_files,
  820. sizeof(*open_file),-1);
  821.  
  822. /* Reallocate and reset parameters. */
  823. open_file= (OPEN_FILE*)REALLOC(open_file,num_files*sizeof(OPEN_FILE));
  824. last_file= open_file+cur_num;
  825. open_file_end= open_file+num_files;
  826. }
  827.  
  828. /* Local dynamic memory. */
  829.  
  830.  
  831. CAST(text_pointer,text_info)->tok_start= tok_ptr= tok_mem;
  832. CAST(text_pointer,txt_dinfo)->tok_start= tok_dptr= tok_dmem;
  833.  
  834. /* This makes replacement text 0 of length zero. */
  835. text_ptr= text_info+1;text_ptr->tok_start= tok_mem;
  836. txt_dptr= txt_dinfo+1;txt_dptr->tok_start= tok_dmem;
  837.  
  838.  
  839.  
  840. CAST(name_pointer,name_dir)->equiv= (EQUIV)text_info;
  841.  
  842.  
  843.  
  844. last_unnamed= text_info;/* Root of the unnamed module. */
  845. CAST(text_pointer,text_info)->text_link= 0;/* No unnamed pieces yet. */
  846.  
  847.  
  848.  
  849. zero_ccodes();/* See \.{style.web}. */
  850. ccode[057]= begin_vcmnt;/* The commenting style is also fundamental, and \
  851.     for convenience the |line_break| command is also inviolate. (For \
  852.     \FTANGLE, this gets reassigned later.) */
  853.  
  854.  
  855. {
  856.  
  857. ini_ccode((outer_char*)"new_module",(outer_char*)" \t*",new_module);
  858.  
  859.  
  860. ini_ccode((outer_char*)"begin_code",(outer_char*)"aA",begin_code);
  861.  
  862. ini_ccode((outer_char*)"module_name",(outer_char*)"<",module_name);
  863.  
  864.  
  865. ini_ccode((outer_char*)"definition",(outer_char*)"dD",definition);
  866.  
  867. ini_ccode((outer_char*)"undefinition",(outer_char*)"uU",undefinition);
  868.  
  869. ini_ccode((outer_char*)"WEB_definition",(outer_char*)"mM",WEB_definition);
  870.  
  871. ini_ccode((outer_char*)"formatt",(outer_char*)"fF",formatt);
  872.  
  873.  
  874. ini_ccode((outer_char*)"ascii_constant",(outer_char*)"'\"",ascii_constant);
  875.  
  876. ini_ccode((outer_char*)"verbatim",(outer_char*)"=",verbatim);
  877.  
  878.  
  879. ini_ccode((outer_char*)"TeX_string",(outer_char*)"tT",TeX_string);
  880.  
  881.  
  882. ini_ccode((outer_char*)"L_switch",(outer_char*)"L",L_switch);
  883.  
  884. ini_ccode((outer_char*)"begin_C",(outer_char*)"cC",begin_C);
  885.  
  886. ini_ccode((outer_char*)"begin_RATFOR",(outer_char*)"rR",begin_RATFOR);
  887.  
  888. ini_ccode((outer_char*)"begin_FORTRAN",(outer_char*)"n",begin_FORTRAN);
  889.  
  890. ini_ccode((outer_char*)"begin_nuweb",(outer_char*)"N",begin_nuweb);
  891.  
  892.  
  893. ini_ccode((outer_char*)"join",(outer_char*)"&",join);
  894.  
  895.  
  896. ini_ccode((outer_char*)"Compiler_Directive",(outer_char*)"?",Compiler_Directive);
  897.  
  898. ini_ccode((outer_char*)"invisible_cmnt",(outer_char*)"%",invisible_cmnt);
  899.  
  900. /* The next three must be reassigned to |control_text|. */
  901.  
  902. ini_ccode((outer_char*)"xref_roman",(outer_char*)"^",xref_roman);
  903.  
  904. ini_ccode((outer_char*)"xref_typewriter",(outer_char*)".",xref_typewriter);
  905.  
  906. ini_ccode((outer_char*)"xref_wildcard",(outer_char*)"9",xref_wildcard);
  907.  
  908.  
  909. ini_ccode((outer_char*)"big_line_break",(outer_char*)"#",big_line_break);
  910.  
  911.  
  912. ini_ccode((outer_char*)"begin_meta",(outer_char*)"(",begin_meta);
  913.  
  914. ini_ccode((outer_char*)"end_meta",(outer_char*)")",end_meta);
  915.  
  916.  
  917. ini_ccode((outer_char*)"limbo_text",(outer_char*)"l",limbo_text);
  918.  
  919. ini_ccode((outer_char*)"op_def",(outer_char*)"vV",op_def);
  920.  
  921. ini_ccode((outer_char*)"macro_def",(outer_char*)"wW",macro_def);
  922.  
  923.  
  924. ini_ccode((outer_char*)"begin_bp",(outer_char*)"{",begin_bp);
  925.  
  926. ini_ccode((outer_char*)"insert_bp",(outer_char*)"}bB",insert_bp);
  927.  
  928.  
  929. ini_ccode((outer_char*)"no_mac_expand",(outer_char*)"!",no_mac_expand);
  930.  
  931.  
  932. ini_ccode((outer_char*)"new_output_file",(outer_char*)"oO",new_output_file);
  933.  
  934.  
  935. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"\001",USED_BY_OTHER);/* This command is for internal use only! */
  936.  
  937. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"\\",USED_BY_OTHER);
  938.  
  939. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"_",USED_BY_OTHER);
  940.  
  941. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"[",USED_BY_OTHER);
  942.  
  943. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"`]",USED_BY_OTHER);
  944.  
  945. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"$",USED_BY_OTHER);
  946. {
  947. char temp[3];
  948.  
  949. sprintf(temp,";%c",XCHR(interior_semi));
  950.  
  951. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)temp,USED_BY_OTHER);
  952. }
  953.  
  954. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"e",USED_BY_OTHER);
  955.  
  956. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)":",USED_BY_OTHER);
  957.  
  958. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)",",USED_BY_OTHER);
  959.  
  960. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"|",USED_BY_OTHER);
  961.  
  962. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"+",USED_BY_OTHER);
  963.  
  964. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"-",USED_BY_OTHER);
  965.  
  966. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"~",USED_BY_OTHER);
  967. #if(DEBUG)
  968.  
  969. ini_ccode((outer_char*)"USED_BY_OTHER",(outer_char*)"012",USED_BY_OTHER);
  970. #endif /* |DEBUG| */
  971. }
  972.  
  973.  
  974.  
  975. {
  976. reassign(xref_roman,control_text);
  977. reassign(xref_typewriter,control_text);
  978. reassign(xref_wildcard,control_text);
  979. reassign(TeX_string,control_text);
  980.  
  981. reassign(verbatim,stringg);
  982. }
  983.  
  984.  
  985. prn_codes();
  986.  
  987.  
  988.  
  989. mod_text[0]= 040;
  990.  
  991.  
  992. ini_internal_fcns();/* Internal built-in function macros. */
  993. ini_Ratfor();/* Initialize \Ratfor. */
  994. }
  995.  
  996.  
  997. ;
  998.  
  999. phase1();/* Read all the user's text and compress it into |tok_mem|. */
  1000. phase2();/* Output the contents of the compressed tables. */
  1001.  
  1002. if(statistics)see_tstatistics();/* Optional statistical info. */
  1003.  
  1004. return wrap_up();/* We actually |exit| from here. */
  1005. }
  1006.  
  1007.  
  1008.  
  1009. SRTN rst_last(VOID)
  1010. RST_LAST_EXPR
  1011.  
  1012.  
  1013.  
  1014. SRTN split_C(VOID)
  1015. {
  1016. #if FANCY_SPLIT
  1017.  
  1018. {
  1019. /* Split strings, but not constants. */
  1020. if(in_string&&split_pos==C_buffer)
  1021. {
  1022.  
  1023. {
  1024. if(!meta_mode)
  1025. *pC_buffer++= '\\';/* There's always room for one more character. */
  1026.  
  1027. C_out(C_buffer,pC_buffer,&pC_buffer,OC("\n"),'\0',NO_INDENT);
  1028. /* Dump out all the way to the end. */
  1029. }
  1030.  
  1031.  
  1032. return;
  1033. }
  1034.  
  1035. *pC_buffer= '\0';
  1036. split0_C(split_pos);
  1037. }
  1038.  
  1039.  
  1040. #else
  1041.  
  1042. {
  1043. if(!meta_mode)
  1044. *pC_buffer++= '\\';/* There's always room for one more character. */
  1045.  
  1046. C_out(C_buffer,pC_buffer,&pC_buffer,OC("\n"),'\0',NO_INDENT);
  1047. /* Dump out all the way to the end. */
  1048. }
  1049.  
  1050.  
  1051. #endif /* |FANCY_SPLIT| */
  1052. }
  1053.  
  1054.  
  1055.  
  1056. #if FANCY_SPLIT
  1057.  
  1058. SRTN split0_C FCN((p))
  1059. outer_char*p C1("Position for the split")
  1060. {
  1061. int indent;
  1062.  
  1063. /* If no break has been found, force a break at the end. */
  1064. if(p==C_buffer)
  1065. {
  1066. *pC_buffer++= '\\';
  1067. p= pC_buffer;
  1068. indent= NO_INDENT;
  1069. }
  1070. else indent= INDENT;
  1071.  
  1072. C_out(C_buffer,p,&pC_buffer,OC("\n"),'\0',indent);
  1073. /* Output from |C_buffer| to~|p|. */
  1074.  
  1075. }
  1076. #endif /* |FANCY_SPLIT| */
  1077.  
  1078.  
  1079.  
  1080. SRTN C_out FCN((C_buffer,p,ppC_buffer,end_str,begin_char,indent))
  1081. outer_char HUGE*C_buffer C0("Buffer we're working with")
  1082. outer_char HUGE*p C0("End (next available pos)")
  1083. outer_char HUGE*HUGE*ppC_buffer C0("")
  1084. outer_char*end_str C0("")
  1085. outer_char begin_char C0("")
  1086. int indent C1("Should the next buffer be indented?")
  1087. {
  1088. int n= *ppC_buffer-p;/* How many left in buffer. */
  1089.  
  1090. if(p>C_buffer)
  1091. WRITE1(C_buffer,p-C_buffer)
  1092.  
  1093. /* Add trailing characters if necessary. */
  1094. if(*end_str)WRITE1(end_str,STRLEN(end_str))
  1095.  
  1096. /* Reset the pointer, then insert the beginning character if necessary. */
  1097. *ppC_buffer= C_buffer;
  1098. if(begin_char)*(*ppC_buffer)++= begin_char;
  1099.  
  1100. /* Add optional indentation (i.e., fill with blanks). */
  1101. while(indent--)
  1102. *(*ppC_buffer)++= ' ';
  1103.  
  1104. /* If there's still stuff in the buffer, move it to the beginning. */
  1105. if(n)
  1106. {
  1107. STRNCPY(*ppC_buffer,p,n);
  1108. *ppC_buffer+= n;/* Reset the current pointer if necessary. */
  1109. }
  1110.  
  1111. flush0();/* Count the lines. */
  1112.  
  1113. {
  1114. split_pos= C_buffer;
  1115. }
  1116.  
  1117.  
  1118. }
  1119.  
  1120.  
  1121.  
  1122. SRTN C_putc FCN((c))
  1123. outer_char c C1("Character to be sent to output.")
  1124. {
  1125. CHECK_OPEN;/* Output files are opened only when necessary. */
  1126.  
  1127. /* Remember the output character, since we may want to spit it out again \
  1128. later, as in |i *= expr| $\to$ |i = i*(expr)|. Turning off the \
  1129. |compound_assignments| flag by option \.{-+} will speed things up a bit. */
  1130. if(compound_assignments&&FORTRAN_LIKE(language))
  1131. if(plast_char>=last_end)last_xpr_overflowed= YES;
  1132. else*plast_char++= c;
  1133.  
  1134. if(dbg_output)printf("c = '%c' (0x%x)\n",c,c);
  1135.  
  1136. if(at_beginning&&meta_mode&&!nuweb_mode&&in_string)
  1137. {/* Invoke |C_putc| recursively. */
  1138. at_beginning= NO;/* Prevent infinite recursion. */
  1139. out_pos= 0;/* For \Fortran. */
  1140. pmeta= &t_style.meta[lan_num(language)];
  1141. OUT_STR(in_version?pmeta->hdr.prefx:pmeta->msg.prefx);
  1142. }
  1143.  
  1144. switch(language)
  1145. {
  1146. case RATFOR:
  1147. case RATFOR_90:
  1148. if(!Ratfor77)
  1149. {
  1150. RAT_out(c);/* Old-style \Ratfor. Modern \
  1151. \Ratfor\ falls through to \Fortran. */
  1152. break;
  1153. }
  1154.  
  1155. case FORTRAN:
  1156. case FORTRAN_90:
  1157. if(reverse_indices&&!in_string)
  1158.  
  1159. {
  1160. switch(c)
  1161. {
  1162. case '(':
  1163. if(rparen)
  1164. {/* The combination `\.{)(}' has occured; advance the \
  1165. buffer level. */
  1166. pai->ilevel++;
  1167.  
  1168.  
  1169. {
  1170. if(!CUR_BUF)
  1171. CUR_BUF= GET_MEM("CUR_BUF",1,TEXT_BUF);
  1172. }
  1173.  
  1174.  
  1175.  
  1176. rparen= NO;
  1177. }
  1178. else
  1179. {/* Time for a new parenthesis level.  Put the parenthesis \
  1180. into the old level.  Remember where that was, then advance the level. */
  1181. store(CUR_BUF,'(');
  1182.  
  1183. (pai+1)->last_buf= CUR_BUF;
  1184. pai++;
  1185. pai->ilevel= 0;
  1186.  
  1187.  
  1188. {
  1189. if(!CUR_BUF)
  1190. CUR_BUF= GET_MEM("CUR_BUF",1,TEXT_BUF);
  1191. }
  1192.  
  1193.  
  1194. }
  1195.  
  1196. break;
  1197.  
  1198. case ')':
  1199. if(!rparen)
  1200. rparen= YES;
  1201. else
  1202. unwind();
  1203.  
  1204. break;
  1205.  
  1206. default:
  1207. if(rparen)
  1208. {
  1209. unwind();
  1210. rparen= NO;
  1211. }
  1212.  
  1213. store(CUR_BUF,c);
  1214. break;
  1215. }
  1216. }
  1217.  
  1218.  
  1219. else
  1220. buffer_out(c);
  1221.  
  1222. break;
  1223.  
  1224. case LITERAL:
  1225. case TEX:
  1226.  
  1227. {
  1228. *pX_buffer++= c;/* Add present character to buffer. */
  1229.  
  1230. if(c=='\n')
  1231. C_out(X_buffer,pX_buffer,&pX_buffer,OC(""),
  1232. (outer_char)CHOICE(meta_mode&&language==TEX,'%','\0'),NO_INDENT);
  1233. else if(pX_buffer==pX_end)
  1234. split_X();
  1235. }
  1236.  
  1237.  
  1238. break;
  1239.  
  1240. case C:
  1241. case C_PLUS_PLUS:
  1242. default:
  1243. #ifndef mac /* \.{Machine-dependent}: Don't buffer C output. */
  1244.  
  1245. {
  1246. *pC_buffer++= c;/* Add present character to buffer. */
  1247.  
  1248. if(c=='\n')
  1249. C_out(C_buffer,pC_buffer,&pC_buffer,OC(""),'\0',NO_INDENT);
  1250. /* Output whole buffer. */
  1251. else if(pC_buffer==pC_end)
  1252. split_C();
  1253. }
  1254.  
  1255.  
  1256. /* If the above buffering (a relatively recent addition) doesn't work, use \
  1257. the following: */
  1258. #else
  1259. if(c=='\n')flush0();/* Count the lines. */
  1260. PUTC(c);
  1261. #endif /* |mac| */
  1262. break;
  1263. }
  1264.  
  1265. at_beginning= BOOLEAN(c=='\n');
  1266. }
  1267.  
  1268.  
  1269.  
  1270. SRTN split_X(VOID)
  1271. {
  1272. outer_char HUGE*p= pX_buffer;
  1273.  
  1274. WHILE()
  1275. {
  1276. if(p==X_buffer)
  1277. {
  1278.  
  1279. err0_print(ERR_T,OC("Line had to be broken"),0);
  1280. C_out(X_buffer,pX_buffer,&pX_buffer,
  1281. language==TEX?OC("%\n"):OC("\n"),
  1282. '\0',NO_INDENT);
  1283. return;
  1284. }
  1285.  
  1286.  
  1287.  
  1288. if(*p==' ')
  1289. {
  1290. C_out(X_buffer,p+1,&pX_buffer,OC("\n"),
  1291. (outer_char)CHOICE(meta_mode&&language==TEX,'%','\0'),
  1292. NO_INDENT);
  1293. return;
  1294. }
  1295.  
  1296. if(*(p--)=='\\'&&*p!='\\')
  1297. {
  1298. C_out(X_buffer,p+1,&pX_buffer,
  1299. language==TEX?OC("%\n"):OC("\n"),
  1300. (outer_char)CHOICE(meta_mode&&language==TEX,'%','\0'),
  1301. NO_INDENT);
  1302. return;
  1303. }
  1304. }
  1305. }
  1306.  
  1307.  
  1308.  
  1309. static outer_char last_out= '\0';/* In \Fortran, the last character output. */
  1310.  
  1311. /* Various flags help \Fortran\ out. */
  1312. static boolean is_label= NO;
  1313. static boolean should_continue= NO;
  1314. static continuation_line= NOT_CONTINUATION;
  1315.  
  1316. static STMT_LBL stmt_num[50];/* Archaic; for numbering \
  1317.             |do|s in \Fortran. Should use \Ratfor\ instead. */
  1318. static short do_level= 0;
  1319.  
  1320.  
  1321.  
  1322. SRTN C_sprintf FCN(VA_ALIST((fmt,n VA_ARGS)))
  1323. VA_DCL(
  1324. CONST outer_char fmt[]C0("String to be printed.")
  1325. int n C2("Number of arguments to follow."))
  1326. {
  1327. VA_LIST(arg_ptr)
  1328. outer_char temp[N_STRBUF];
  1329. outer_char HUGE*t;
  1330.  
  1331. VA_START(arg_ptr,n);
  1332.  
  1333. #if(NUM_VA_ARGS==1)
  1334. {
  1335. char*fmt0= va_arg(arg_ptr,char*);
  1336.  
  1337. va_arg(arg_ptr,int);
  1338. vsprintf((char*)(char*)temp,fmt0,arg_ptr);
  1339. }
  1340. #else
  1341. vsprintf((char*)temp,(CONST char*)fmt,arg_ptr);
  1342. #endif /* Length not checked now. */
  1343. va_end(arg_ptr);
  1344.  
  1345. for(t= temp;*t;++t)C_putc(*t);
  1346. }
  1347.  
  1348.  
  1349.  
  1350. SRTN RAT_out FCN((c))
  1351. outer_char c C1("Output this character to \Ratfor.")
  1352. {
  1353. switch(c)
  1354. {
  1355. case end_meta:
  1356. send_new_line;
  1357. return;
  1358.  
  1359. case begin_meta:
  1360. if(meta_mode)return;/* The second in a row. */
  1361. meta_mode= YES;/* NOTE: FALLS THROUGH to next case. */
  1362.  
  1363. case '\n':
  1364. send_new_line;
  1365. if(meta_mode)PUTC('#');/* \Ratfor\ comment. */
  1366. return;
  1367.  
  1368. default:
  1369. PUTC(c);
  1370. return;
  1371. }
  1372. }
  1373.  
  1374.  
  1375.  
  1376. SRTN buffer_out FCN((c))
  1377. outer_char c C1("Output this character to the \Fortran\ buffer.")
  1378. {
  1379. outer_char*px;/* For |in_string| |meta_mode| processing. */
  1380.  
  1381.  
  1382.  
  1383. switch(c)
  1384. {
  1385. case '\0':if(!in_string)return;/* In case a null sneaks in, ignore it. */
  1386.  
  1387. /* Reset the verbatim comment mode. We have to remember whether we were in \
  1388. the middle of a line; if we were, we must resume continuation mode. */
  1389. if(in_string&&started_vcmnt)
  1390. {
  1391. NEWLINE_TO_FORTRAN(should_continue);
  1392. started_vcmnt= NO;
  1393. return;
  1394. }
  1395. break;
  1396.  
  1397. case '{':
  1398. case '}':
  1399. /* Filter out braces from \Ratfor. */
  1400. if(!in_string&&xpn_Ratfor)return;
  1401. break;
  1402.  
  1403. /* Ignore any blanks at beginning of line. */
  1404. case ' ':
  1405. if(out_at_beginning)return;
  1406. break;
  1407.  
  1408.  
  1409.  
  1410. case '\n':
  1411. if(in_cdir)
  1412. {
  1413. out_pos= 0;
  1414. }
  1415. else if(!in_string||(in_string&&started_vcmnt))
  1416. {
  1417. NEWLINE_TO_FORTRAN(NOT_CONTINUATION);
  1418.  
  1419. if(in_string&&started_vcmnt)
  1420. {
  1421. int k;
  1422.  
  1423. if(!meta_mode)
  1424. {
  1425. outp_buf[0]= begin_comment_char[lan_num(out_language)];
  1426.  
  1427. for(out_pos= 1,k= spcs_after_cmnt;k;k--)
  1428. outp_buf[out_pos++]= ' ';
  1429. }
  1430.  
  1431. nbuf_length= MAX(t_style.output_line_length,80);
  1432. out_at_beginning= NO;/* Prevents stripping off blanks at beginning of cmnt. */
  1433. }
  1434.  
  1435.  
  1436. }
  1437. else if(!started_vcmnt)
  1438. {/* Remember if  there's stuff in the buffer. If so, when \
  1439. we terminate the verbatim comment we must continue. */
  1440. should_continue= BOOLEAN(out_pos>rst_pos);
  1441.  
  1442. /* The next statement prevents overwriting the stuff already in the buffer. */
  1443. if(should_continue){NEWLINE_TO_FORTRAN(NOT_CONTINUATION);}
  1444. should_continue= BOOLEAN((!free_Fortran)&&should_continue);
  1445.  
  1446. {
  1447. int k;
  1448.  
  1449. if(!meta_mode)
  1450. {
  1451. outp_buf[0]= begin_comment_char[lan_num(out_language)];
  1452.  
  1453. for(out_pos= 1,k= spcs_after_cmnt;k;k--)
  1454. outp_buf[out_pos++]= ' ';
  1455. }
  1456.  
  1457. nbuf_length= MAX(t_style.output_line_length,80);
  1458. out_at_beginning= NO;/* Prevents stripping off blanks at beginning of cmnt. */
  1459. }
  1460.  
  1461. ;
  1462. started_vcmnt= YES;
  1463. }
  1464.  
  1465. return;
  1466.  
  1467.  
  1468.  
  1469.  
  1470. /* Semicolons not in strings mean emit a new line (except when they were \
  1471. earlier translated into |semi| during stringizing). */
  1472. case ';':
  1473. if(!(in_string||in_constant))
  1474. {
  1475. NEWLINE_TO_FORTRAN(NOT_CONTINUATION);
  1476. return;
  1477. }
  1478. break;
  1479.  
  1480. case interior_semi:
  1481. case semi:
  1482. c= ';';break;
  1483.  
  1484. /* Handle meta-comments. */
  1485. case begin_meta:
  1486. if(!meta_mode&&last_out!='\n')flush_out(YES);
  1487. meta_mode= YES;
  1488. if(in_string)
  1489. {/* Start standard meta-comment. */
  1490. TO_BUFFER(top);
  1491. if(out_pos>0)flush_out(YES);
  1492. }
  1493. rst_out(NOT_CONTINUATION);
  1494. return;
  1495.  
  1496. case end_meta:
  1497. if(in_string)
  1498. {/* Finish standard meta-comment. */
  1499. TO_BUFFER(bottom);
  1500. if(out_pos>0)flush_out(YES);
  1501. started_vcmnt= NO;
  1502. }
  1503. else flush_out(YES);
  1504.  
  1505. rst_out(NOT_CONTINUATION);
  1506. return;
  1507. }
  1508.  
  1509. /* If we're still going at column 73, emit a new line and make the next \
  1510. line a continuation line. */
  1511. if(out_pos>=nbuf_length)
  1512. {
  1513. if(free_Fortran)outp_buf[out_pos++]= '&';/* Standard F--90 contin. */
  1514. flush_out(YES);
  1515. rst_out(CONTINUATION);/* Continuation. */
  1516.  
  1517. if(in_string&&started_vcmnt)
  1518. {
  1519. int k;
  1520.  
  1521. if(!meta_mode)
  1522. {
  1523. outp_buf[0]= begin_comment_char[lan_num(out_language)];
  1524.  
  1525. for(out_pos= 1,k= spcs_after_cmnt;k;k--)
  1526. outp_buf[out_pos++]= ' ';
  1527. }
  1528.  
  1529. nbuf_length= MAX(t_style.output_line_length,80);
  1530. out_at_beginning= NO;/* Prevents stripping off blanks at beginning of cmnt. */
  1531. }
  1532.  
  1533. ;
  1534. }
  1535.  
  1536. if(out_at_beginning)
  1537. {
  1538. out_at_beginning= NO;
  1539.  
  1540. /* Statement labels require special treatment. When we sense one, we raise \
  1541. a special flag and put them into column~1. */
  1542. if(!in_string)
  1543. if(isdigit(c)&&!is_label)
  1544. {
  1545. is_label= YES;
  1546. out_pos= 0;
  1547. }
  1548. else if(c=='#')
  1549. {/* Place the \&{\#line} command in column~1. */
  1550. outp_buf[0]= (outer_char)CHOICE(free_90,
  1551. begin_comment_char[lan_num(out_language)],'*');
  1552. /* Treat as comment. */
  1553. out_pos= 1;
  1554. return;
  1555. }
  1556. }
  1557.  
  1558.  
  1559.  
  1560. /* When a statement label ends, skip to column~7. */
  1561. if(is_label&&!isdigit(c))
  1562. {
  1563. is_label= NO;
  1564. out_pos= 6+indent_level*INDENT_SIZE;
  1565. if(c==':'||c==' ')return;/* Throw away the trailing colon. */
  1566. }
  1567.  
  1568.  
  1569.  
  1570. if(number_dos&&!continuation_line&&(language==FORTRAN||
  1571. language==FORTRAN_90||R66))
  1572. {
  1573. outer_char HUGE*do_pos;
  1574.  
  1575. do_pos= outp_buf+6;
  1576.  
  1577. if(out_pos==9)
  1578. {
  1579. if(STRNCMP(do_pos,"do ",3)==0&&!isdigit(c))
  1580. {
  1581. sprintf((char*)(do_pos+= 3),"%lu ",
  1582. stmt_num[do_level++]= max_stmt++);
  1583.  
  1584. while(*do_pos++!='\0')out_pos++;
  1585. }
  1586. }
  1587. else if((out_pos==10&&STRNCMP(do_pos,"endd",4)==0)||
  1588. (out_pos==11&&STRNCMP(do_pos,"end d",5)==0))
  1589. {
  1590. if(do_level==0)
  1591. {
  1592.  
  1593. err0_print(ERR_T,OC("Too many END DOs"),0);
  1594. *outp_buf= 'C';
  1595. }
  1596. else
  1597. {
  1598. sprintf((char*)outp_buf,"%-5lu CONTINUE",
  1599. stmt_num[--do_level]);
  1600. out_pos= 14;
  1601. return;
  1602. }
  1603. }
  1604. }
  1605.  
  1606.  
  1607.  
  1608. /* Can't put it off any longer: Put the character into the buffer. */
  1609. last_out= outp_buf[out_pos++]= c;
  1610.  
  1611. return;
  1612. }
  1613.  
  1614.  
  1615.  
  1616. SRTN flush_out FCN((prn_new_line))
  1617. boolean prn_new_line C1("Do we print a newline?")
  1618. {
  1619. outp_buf[out_pos]= '\0';/* Terminate the buffer. */
  1620.  
  1621. /* Dump it out, followed by a newline. */
  1622. WRITE1(outp_buf,out_pos)
  1623.  
  1624. if(prn_new_line)
  1625. {
  1626. PUTC(last_out= '\n');
  1627. flush0();
  1628. }
  1629. }
  1630.  
  1631.  
  1632.  
  1633. int rst_out FCN((continuation))
  1634. boolean continuation C1("Is line a continuation?")
  1635. {
  1636. if(!continuation)RST_LAST_EXPR /* Reset the pointer so we can remember the \
  1637.                     upcoming expression. */
  1638.  
  1639. /* Blank out the comment and label field (first five columns). */
  1640. for(out_pos= 0;out_pos<5;++out_pos)
  1641. outp_buf[out_pos]= ' ';
  1642.  
  1643. /* Deposit the continuation character. */
  1644. outp_buf[out_pos++]= continuation?t_style.cchar:(outer_char)' ';
  1645. continuation_line= continuation;
  1646. out_at_beginning= BOOLEAN(!continuation_line);
  1647.  
  1648. nbuf_length= t_style.output_line_length;
  1649.  
  1650. if(meta_mode)
  1651. {
  1652. if(!in_string)
  1653. {/* Error message. */
  1654. outp_buf[0]= begin_comment_char[lan_num(out_language)];
  1655. if(!xpn_Ratfor)out_pos= 1+spcs_after_cmnt;
  1656. }
  1657.  
  1658. nbuf_length= MAX(nbuf_length,80);
  1659. }
  1660.  
  1661. /* If it's not a continuation line, mark the beginning. Also, if we're in a \
  1662. loop, indent appropriately. */
  1663. if(out_at_beginning&&xpn_Ratfor)blank_out(indent_level);
  1664.  
  1665. return rst_pos= out_pos;
  1666. }
  1667.  
  1668.  
  1669.  
  1670. SRTN blank_out FCN((n))
  1671. int n C1("Number of levels to indent.")
  1672. {
  1673. outer_char HUGE*p;
  1674. int i;
  1675.  
  1676. for(i= 0,p= outp_buf+out_pos;i<n*INDENT_SIZE;i++)*p++= ' ';
  1677.  
  1678. out_pos+= i;
  1679. rst_pos= out_pos;
  1680. }
  1681.  
  1682.  
  1683.  
  1684. SRTN store FCN((t,c))
  1685. TEXT_BUF HUGE*t C0("")
  1686. outer_char c C1("")
  1687. {
  1688. if(pai==paren_level||t==paren_level[0].last_buf)
  1689. {/* Send directly to \Fortran's output buffer. */
  1690. buffer_out(c);
  1691. return;
  1692. }
  1693.  
  1694. /* Store in the indicated text buffer; initialize that if necessary. */
  1695. if(t->start==NULL)
  1696. {
  1697. t->pos= t->start= calloc(100,1);
  1698. t->end= t->start+100;
  1699. }
  1700.  
  1701. *t->pos++= c;
  1702. }
  1703.  
  1704.  
  1705.  
  1706. SRTN unwind(VOID)
  1707. {
  1708. int i;
  1709. TEXT_BUF HUGE*t;
  1710. outer_char HUGE*s1;
  1711.  
  1712. if(pai==paren_level)
  1713. {
  1714.  
  1715. err0_print(ERR_T,OC("Missing '('"),0);
  1716. buffer_out(')');
  1717. return;
  1718. }
  1719.  
  1720. for(i= pai->ilevel;i>=0;i--)
  1721. {
  1722. t= pai->text_buf[i];
  1723.  
  1724. for(s1= t->start;s1<t->pos;s1++)
  1725. store(pai->last_buf,*s1);
  1726.  
  1727. t->pos= t->start;/* Reset the buffer. */
  1728.  
  1729. if(i>0)
  1730. store(pai->last_buf,',');
  1731. }
  1732.  
  1733. store(pai->last_buf,')');
  1734. pai--;/* Decrement parenthesis level. */
  1735. }
  1736.  
  1737.  
  1738.  
  1739.  
  1740. boolean names_match FCN((p,first,l,dummy))
  1741. name_pointer p C0("Points to the proposed match.")
  1742. CONST ASCII HUGE*first C0("Position of first character of string.")
  1743. int l C0("length of identifier.")
  1744. eight_bits dummy C1("Not used here")
  1745. {
  1746. if(length(p)!=l)return NO;
  1747. return(boolean)(!STRNCMP(first,p->byte_start,l));
  1748. }
  1749.  
  1750.  
  1751.  
  1752. SRTN ini_node FCN((node))
  1753. CONST name_pointer node C1("")
  1754. {
  1755. node->equiv= (EQUIV)text_info;
  1756.  
  1757. {
  1758. /* We allocate |MOD_INFO| structures only for module names, not for \
  1759.     identifiers. */
  1760. node->mod_info= GET_MEM("mod_info",1,MOD_INFO);
  1761.  
  1762. node->mod_info->Ilk= expr;
  1763. node->mod_info->params= params;/* Freeze parameters at this point in time. */
  1764.  
  1765.  
  1766. node->Language= (boolean)language;/* Redundant. */
  1767. }
  1768.  
  1769.  
  1770.  
  1771. }
  1772.  
  1773.  
  1774.  
  1775. SRTN ini_p FCN((p,t))
  1776. name_pointer p C0("")
  1777. eight_bits t C1("")
  1778. {}
  1779.  
  1780. SRTN open_tex_file(VOID)
  1781. {}
  1782.  
  1783.  
  1784.  
  1785. SRTN store_two_bytes FCN((x))
  1786. sixteen_bits x C1("Two-byte token to be entered into |tok_mem|.")
  1787. {
  1788. if(tok_ptr+2>tok_m_end)OVERFLW("tokens","tt");
  1789.  
  1790. *tok_ptr++= (eight_bits)(x>>8);/* Store high byte. */
  1791. *tok_ptr++= (eight_bits)(x&0377);/* Store low byte. */
  1792. }
  1793.  
  1794.  
  1795.  
  1796. SRTN push_level FCN((p,b0,b1))
  1797. name_pointer p C0("The new replacement text.")
  1798. CONST eight_bits HUGE*b0 C0("If |p == NULL|, beginning of new \
  1799. stuff in memory.")
  1800. CONST eight_bits HUGE*b1 C1("If |p == NULL|, end of new stuff in \
  1801. memory.")
  1802. {
  1803. if(stck_ptr==stck_end)OVERFLW("stack levels","kt");
  1804.  
  1805. *stck_ptr= cur_state;/* Save old state. */
  1806.  
  1807. /* Initialize new state. */
  1808. cur_name= p;
  1809.  
  1810. if(p!=NULL)
  1811. {
  1812. cur_repl= (text_pointer)p->equiv;
  1813.  
  1814. if(cur_repl==NULL)CONFUSION("push_level","cur_repl is NULL");
  1815.  
  1816. cur_byte= cur_repl->tok_start;
  1817. cur_end= (cur_repl+1)->tok_start;
  1818. }
  1819. else
  1820. {
  1821. cur_repl= NULL;
  1822.  
  1823. cur_byte= (eight_bits HUGE*)b0;cur_end= (eight_bits HUGE*)b1;
  1824. new_mbuf();/* Allocate new macro buffer. See \.{macs.web}. */
  1825. }
  1826.  
  1827. /* Get the language for this module. All modules start off in the global \
  1828. language for that module. Also, the old state needs to recall the local \
  1829. language switch. */
  1830. (stck_ptr++)->params= cur_params= cur_global_params= 
  1831. (p!=NULL)?params:params;/* ??? */
  1832. set_output_file(cur_language);
  1833. cur_mod= UNNAMED_MODULE;/* Assume this until told otherwise. */
  1834. }
  1835.  
  1836.  
  1837.  
  1838. boolean pop_level(VOID)/* do this when |cur_byte| reaches |cur_end| */
  1839. {
  1840. if(cur_repl!=NULL&&cur_repl->text_link<module_flag)
  1841. {/* Link to a continuation---i.e., the next in the chain of \
  1842. replacement texts for this module. */
  1843. cur_repl= cur_repl->text_link+text_info;/* Stay on the same level. */
  1844. cur_byte= cur_repl->tok_start;
  1845. cur_end= (cur_repl+1)->tok_start;
  1846.  
  1847. /* In case we changed languages during the module, localize the change. */
  1848. if(cur_repl->module_text)
  1849. {
  1850. params= cur_params= cur_global_params;
  1851. frz_params();
  1852. set_output_file(cur_language);
  1853. }
  1854.  
  1855. return YES;
  1856. }
  1857.  
  1858. stck_ptr--;/* Go down to the previous level. */
  1859.  
  1860. if(stck_ptr>stack)
  1861. {
  1862. cur_state= *stck_ptr;/* Copy the current state structure. */
  1863. set_output_file(cur_language);
  1864. return YES;/* Successfully descended to a lower active level. */
  1865. }
  1866.  
  1867. return NO;/* Already at lowest level (top of stack). */
  1868. }
  1869.  
  1870.  
  1871. eight_bits get_output(VOID)
  1872. {
  1873. sixteen_bits a;/* Value of current byte. */
  1874.  
  1875. restart:
  1876. if(stck_ptr==stack)return NO;/* At top of stack; nothing more. */
  1877.  
  1878. if(cur_byte==cur_end)
  1879. {
  1880. cur_val= -((long)cur_mod);/* When we end a module, |cur_val| is \
  1881. set to the negative of the module number.  The cast is needed because of \
  1882. sign extension. */
  1883.  
  1884. if(cur_val!=ignore)OUT_CHAR(module_number);/* Do this here so \
  1885. it gets into the right file if we're changing languages. */
  1886.  
  1887. pop_level();
  1888.  
  1889. if(cur_val==ignore)goto restart;
  1890.  
  1891. return module_number;
  1892. }
  1893.  
  1894.  
  1895. {
  1896. a= *cur_byte++;
  1897.  
  1898. if(TOKEN1(a))
  1899. {
  1900.  
  1901. {
  1902. send_single(a);
  1903. }
  1904.  
  1905. ;
  1906. return sent;
  1907. }
  1908. else
  1909. {
  1910. a= IDENTIFIER(a,*cur_byte++);
  1911.  
  1912. switch(a/MODULE_NAME)
  1913. {
  1914. case 0:
  1915. cur_val= a;
  1916.  
  1917. {
  1918. IN_RATFOR boolean balanced;
  1919. IN_RATFOR ASCII cur_delim;
  1920.  
  1921. if(!balanced&&language==RATFOR&&
  1922. (a==id_function||a==id_program||a==id_subroutine))
  1923. {
  1924.  
  1925. RAT_error(ERROR,OC("Inserted missing '%c' at beginning of function"),1,XCHR(cur_delim));
  1926. cur_byte-= 2;/* Process the current identifier again. */
  1927. return OUT_CHAR(cur_delim);/* Insert delimiter being searched for. */
  1928. }
  1929. }
  1930.  
  1931.  
  1932. return OUT_CHAR(identifier);
  1933.  
  1934. case 1:
  1935.  
  1936. {
  1937. name_pointer np;
  1938.  
  1939. a-= MODULE_NAME;
  1940.  
  1941. np= name_dir+a;
  1942.  
  1943. if(np->equiv!=(EQUIV)text_info)push_level(np,NULL,NULL);
  1944. else if(a!=UNNAMED_MODULE)
  1945. {/* Module definition missing. */
  1946. SET_COLOR(error);
  1947. printf("\n! Not present: <");prn_id(np);
  1948. err0_print(ERR_NULL,OC(">"),0);
  1949.  
  1950. SET_COLOR(ordinary);
  1951.  
  1952. {
  1953. #define TEMP_LEN 300
  1954.  
  1955. eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
  1956. sixteen_bits stub;
  1957. size_t n= length(np);
  1958.  
  1959. id_first= x__to_ASCII(OC("$STUB"));
  1960. stub= ID_NUM(id_first,id_first+5);
  1961.  
  1962. STRNCPY(temp1,np->byte_start,n);
  1963. temp1[n]= '\0';
  1964.  
  1965.  
  1966. if(
  1967. nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
  1968. push_level(NULL,temp,temp+STRLEN(temp));
  1969.  
  1970. #undef TEMP_LEN
  1971. }
  1972.  
  1973.  
  1974. }
  1975. }
  1976.  
  1977.  
  1978. goto restart;
  1979.  
  1980. default:
  1981. cur_val= a-MODULE_NUM;
  1982. if(cur_val>UNNAMED_MODULE)cur_mod= (sixteen_bits)cur_val;
  1983. /* Remember the current module so it can be used in \
  1984. |out_char(module_number)| just after popping this level. */
  1985. return OUT_CHAR(module_number);/* Module number at \
  1986. beginning  of module. */
  1987. }
  1988. }
  1989. }
  1990.  
  1991.  
  1992. }
  1993.  
  1994.  
  1995.  
  1996. eight_bits get_saved_output FCN((stck_ptr0))
  1997. stack_pointer stck_ptr0 C1("")
  1998. {
  1999. sixteen_bits a;
  2000.  
  2001. restart:
  2002. if(stck_ptr==stack||stck_ptr!=stck_ptr0)return NO;
  2003.  
  2004. if(DONE_LEVEL)
  2005. {/* Hunt for end-of-tokens mark. */
  2006. if(!pop_level())CONFUSION("get_saved_output",
  2007. "Shouldn't encounter top level here");
  2008. return ignore;
  2009. }
  2010.  
  2011.  
  2012. {
  2013. a= *cur_byte++;
  2014.  
  2015. if(TOKEN1(a))
  2016. {
  2017.  
  2018. {
  2019. send_single(a);
  2020. }
  2021.  
  2022. ;
  2023. return sent;
  2024. }
  2025. else
  2026. {
  2027. a= IDENTIFIER(a,*cur_byte++);
  2028.  
  2029. switch(a/MODULE_NAME)
  2030. {
  2031. case 0:
  2032. cur_val= a;
  2033.  
  2034. {
  2035. IN_RATFOR boolean balanced;
  2036. IN_RATFOR ASCII cur_delim;
  2037.  
  2038. if(!balanced&&language==RATFOR&&
  2039. (a==id_function||a==id_program||a==id_subroutine))
  2040. {
  2041.  
  2042. RAT_error(ERROR,OC("Inserted missing '%c' at beginning of function"),1,XCHR(cur_delim));
  2043. cur_byte-= 2;/* Process the current identifier again. */
  2044. return OUT_CHAR(cur_delim);/* Insert delimiter being searched for. */
  2045. }
  2046. }
  2047.  
  2048.  
  2049. return OUT_CHAR(identifier);
  2050.  
  2051. case 1:
  2052.  
  2053. {
  2054. name_pointer np;
  2055.  
  2056. a-= MODULE_NAME;
  2057.  
  2058. np= name_dir+a;
  2059.  
  2060. if(np->equiv!=(EQUIV)text_info)push_level(np,NULL,NULL);
  2061. else if(a!=UNNAMED_MODULE)
  2062. {/* Module definition missing. */
  2063. SET_COLOR(error);
  2064. printf("\n! Not present: <");prn_id(np);
  2065. err0_print(ERR_NULL,OC(">"),0);
  2066.  
  2067. SET_COLOR(ordinary);
  2068.  
  2069. {
  2070. #define TEMP_LEN 300
  2071.  
  2072. eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
  2073. sixteen_bits stub;
  2074. size_t n= length(np);
  2075.  
  2076. id_first= x__to_ASCII(OC("$STUB"));
  2077. stub= ID_NUM(id_first,id_first+5);
  2078.  
  2079. STRNCPY(temp1,np->byte_start,n);
  2080. temp1[n]= '\0';
  2081.  
  2082.  
  2083. if(
  2084. nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
  2085. push_level(NULL,temp,temp+STRLEN(temp));
  2086.  
  2087. #undef TEMP_LEN
  2088. }
  2089.  
  2090.  
  2091. }
  2092. }
  2093.  
  2094.  
  2095. goto restart;
  2096.  
  2097. default:
  2098. cur_val= a-MODULE_NUM;
  2099. if(cur_val>UNNAMED_MODULE)cur_mod= (sixteen_bits)cur_val;
  2100. /* Remember the current module so it can be used in \
  2101. |out_char(module_number)| just after popping this level. */
  2102. return OUT_CHAR(module_number);/* Module number at \
  2103. beginning  of module. */
  2104. }
  2105. }
  2106. }
  2107.  
  2108.  
  2109. }
  2110.  
  2111.  
  2112.  
  2113. SRTN copy_out FCN((p0,p1,is_expr))
  2114. CONST eight_bits HUGE*p0 C0("Start of memory buffer.")
  2115. CONST eight_bits HUGE*p1 C0("End of memory buffer.")
  2116. boolean is_expr C1("Flag for resetting pointer to last expression.")
  2117. {
  2118. stack_pointer stck_ptr0;
  2119.  
  2120. /* If we're copying out an expression, reset the memory pointer. */
  2121. if(is_expr)rst_last();
  2122.  
  2123. push_level(NULL,p0,p1);
  2124. stck_ptr0= stck_ptr;
  2125. while(get_saved_output(stck_ptr0));
  2126. }
  2127.  
  2128.  
  2129.  
  2130. SRTN send_single FCN((a))
  2131. sixteen_bits a C1("")
  2132. {
  2133. boolean scope;
  2134.  
  2135. switch(a)
  2136. {
  2137. case begin_language:
  2138. /* |begin_language| escapes the actual language, which follows next. */
  2139. switch(sent= *cur_byte++)
  2140. {
  2141. case NO_LANGUAGE:/* Serves double-duty for |new_output_file|. */
  2142. scope= *cur_byte++;
  2143. a= *cur_byte++;
  2144. a= IDENTIFIER(a,*cur_byte++);
  2145. new_out(scope,a);
  2146. sent= new_output_file;
  2147. break;
  2148.  
  2149.  
  2150.  
  2151. case C:opn_output_file(C);break;
  2152. case C_PLUS_PLUS:opn_output_file(C_PLUS_PLUS);break;
  2153. case RATFOR:
  2154. if(!RAT_OK("(send_single)"))
  2155. CONFUSION("output default","Ratfor command during output");
  2156. opn_output_file(RATFOR);
  2157. break;
  2158. case RATFOR_90:
  2159. if(!RAT_OK("(send_single)"))
  2160. CONFUSION("output default","Ratfor command during output");
  2161. opn_output_file(RATFOR_90);
  2162. break;
  2163. case FORTRAN:opn_output_file(FORTRAN);break;
  2164. case FORTRAN_90:opn_output_file(FORTRAN_90);break;
  2165. case TEX:opn_output_file(TEX);break;
  2166. case LITERAL:opn_output_file(LITERAL);break
  2167.  
  2168. ;
  2169.  
  2170. case NUWEB_OFF:
  2171. case NUWEB_ON:
  2172. nuweb_mode= BOOLEAN(0x0F&sent);
  2173. break;
  2174.  
  2175. case no_mac_expand:
  2176. mac_protected= no_expand= YES;
  2177. break;
  2178. }
  2179. break;
  2180.  
  2181. case dot_const:
  2182. cur_val= *cur_byte++;/* The relative number of the \
  2183. operator is stored in the byte following |dot_const|. */
  2184. sent= OUT_CHAR(a);
  2185. break;
  2186.  
  2187. default:
  2188. sent= OUT_CHAR(a);/* One-byte token. */
  2189. break;
  2190. }
  2191. }
  2192.  
  2193.  
  2194.  
  2195. #define TEMP_LEN (2*MAX_FILE_NAME_LENGTH)
  2196.  
  2197. SRTN new_out FCN((global_scope,a))
  2198. boolean global_scope C0("0 for local, 1 for global")
  2199. sixteen_bits a C1("")
  2200. {
  2201. name_pointer np= name_dir+a;
  2202. CONST ASCII HUGE*end;
  2203. size_t len;
  2204. outer_char temp_from[TEMP_LEN],temp_to[TEMP_LEN];
  2205. outer_char temp[MAX_FILE_NAME_LENGTH];
  2206.  
  2207. if(global_scope)
  2208. {
  2209.  
  2210. if(
  2211. nsprintf(temp_from,OC("\n\n  (This file was continued via @O from %s.)"),1,params.OUTPUT_FILE_NAME)>=(int)(TEMP_LEN))OVERFLW("temp_from","");
  2212. }
  2213. else
  2214. {
  2215.  
  2216. if(
  2217. nsprintf(temp_from,OC(" "),0)>=(int)(TEMP_LEN))OVERFLW("temp_from","");
  2218. }
  2219.  
  2220. /* Extract the file name from the |name_dir|. */
  2221. PROPER_END(end);
  2222. len= end-np->byte_start;
  2223. STRNCPY(temp,np->byte_start,len);
  2224. TERMINATE(temp,len);
  2225. to_outer((ASCII HUGE*)temp);
  2226. new_fname(¶ms.OUTPUT_FILE_NAME,temp,NULL);
  2227.  
  2228.  
  2229. if(global_scope)
  2230. {/* Write a continuation message into the old file. */
  2231. new_fname(&global_params.OUTPUT_FILE_NAME,temp,NULL);
  2232.  
  2233. if(
  2234. nsprintf(temp_to,OC("  (Continued via @O to %s.)"),1,params.OUTPUT_FILE_NAME)>=(int)(TEMP_LEN))OVERFLW("temp_to","");
  2235. OUT_MSG(to_ASCII(temp_to),NULL);
  2236. close_out(out_file);
  2237. }
  2238. else
  2239. fflush(out_file);
  2240.  
  2241. open_out(temp_from,global_scope);
  2242. }
  2243.  
  2244. #undef TEMP_LEN
  2245.  
  2246.  
  2247.  
  2248. SRTN i_mod_name_ FCN((n,pargs))
  2249. int n C0("")
  2250. PARGS pargs C1("")
  2251. {
  2252. int len;
  2253. name_pointer np= cur_name;
  2254. eight_bits HUGE*p;
  2255.  
  2256. CHK_ARGS("$MODULE_NAME",0);
  2257.  
  2258. if(cur_name)cur_mod_no= np-name_dir;
  2259. else cur_mod_no= 0;
  2260.  
  2261. len= cur_mod_no?length(np):STRLEN(UNNAMED_MOD);
  2262. MCHECK(len,"current module name");
  2263.  
  2264. if(cur_mod_no)
  2265. for(p= np->byte_start;p<(np+1)->byte_start;)
  2266. *mp++= *p++;
  2267. else
  2268. {
  2269. STRCPY(mp,UNNAMED_MOD);
  2270. to_ASCII(mp);
  2271. mp+= len;
  2272. }
  2273. }
  2274.  
  2275.  
  2276.  
  2277. SRTN i_sect_num_ FCN((n,pargs))
  2278. int n C0("")
  2279. PARGS pargs C1("")
  2280. {
  2281. num_to_mbuf(n,pargs,"$SECTION_NUM",0,"section number",cur_mod);
  2282. }
  2283.  
  2284.  
  2285.  
  2286. SRTN x_mod_a FCN((a))
  2287. sixteen_bits a C1("")
  2288. {
  2289.  
  2290. {
  2291. name_pointer np;
  2292.  
  2293. a-= MODULE_NAME;
  2294.  
  2295. np= name_dir+a;
  2296.  
  2297. if(np->equiv!=(EQUIV)text_info)push_level(np,NULL,NULL);
  2298. else if(a!=UNNAMED_MODULE)
  2299. {/* Module definition missing. */
  2300. SET_COLOR(error);
  2301. printf("\n! Not present: <");prn_id(np);
  2302. err0_print(ERR_NULL,OC(">"),0);
  2303.  
  2304. SET_COLOR(ordinary);
  2305.  
  2306. {
  2307. #define TEMP_LEN 300
  2308.  
  2309. eight_bits temp[TEMP_LEN],temp1[TEMP_LEN];
  2310. sixteen_bits stub;
  2311. size_t n= length(np);
  2312.  
  2313. id_first= x__to_ASCII(OC("$STUB"));
  2314. stub= ID_NUM(id_first,id_first+5);
  2315.  
  2316. STRNCPY(temp1,np->byte_start,n);
  2317. temp1[n]= '\0';
  2318.  
  2319.  
  2320. if(
  2321. nsprintf(temp,OC("%c%c%c%c%s%c%c"),7,LEFT(stub,ID0),RIGHT(stub),050,stringg,temp1,stringg,051)>=(int)(TEMP_LEN))OVERFLW("temp","");
  2322. push_level(NULL,temp,temp+STRLEN(temp));
  2323.  
  2324. #undef TEMP_LEN
  2325. }
  2326.  
  2327.  
  2328. }
  2329. }
  2330.  
  2331.  
  2332. }
  2333.  
  2334.  
  2335.  
  2336. SRTN flush0()
  2337. {
  2338. /* This routine might be called during phase~1, because error messages use \
  2339. the output buffering routines.  However, we don't want to update \
  2340. |cur_line|, which counts the input lines during phase~1. */
  2341. if(phase==1)return;
  2342.  
  2343. /* Give some feedback to the terminal by printing a dot every so often, and \
  2344. the line number somewhat less often. */
  2345. if(cur_line%100==0)
  2346. {
  2347. if(cur_line%500==0){CLR_PRINTF(line_num,("%u",cur_line));}
  2348. else putchar('.');
  2349.  
  2350. UPDATE_TERMINAL;/* Progress report. */
  2351. }
  2352.  
  2353. cur_line++;
  2354. OUTPUT_LINE++;
  2355. }
  2356.  
  2357.  
  2358.  
  2359. SRTN phase2(VOID)
  2360. {
  2361. phase= 2;
  2362.  
  2363. params= global_params;
  2364. frz_params();
  2365. set_output_file(global_language);
  2366.  
  2367. /* Get the FORTRAN output buffer ready. */
  2368. rst_out(NOT_CONTINUATION);
  2369.  
  2370. CLR_PRINTF(info,("\nWriting the %soutput file(s):",
  2371. compare_outfiles?"temporary ":""));
  2372. printf("  ");
  2373. UPDATE_TERMINAL;
  2374.  
  2375. cur_line= 1;
  2376.  
  2377. if(CAST(text_pointer,text_info)->text_link==0)
  2378. {/* There was no program text. */
  2379. CLR_PRINTF(warning,("\n! No program text was specified."));
  2380. mark_harmless;
  2381.  
  2382. }
  2383. else
  2384. {/* There is program text. */
  2385.  
  2386. {
  2387. name_pointer np;
  2388.  
  2389. npmax= name_ptr-1;/* Used in output routine. */
  2390.  
  2391. if(truncate_ids)
  2392. {
  2393. unsigned n= 0;/* Counts number of truncations. */
  2394.  
  2395. printf("\nTruncating %u identifiers...",name_ptr-name_dir);
  2396.  
  2397. for(np= name_dir+1;np<name_ptr;np++)
  2398. n+= trunc_id(np);
  2399.  
  2400. printf("\n%u truncation(s) performed.",n);
  2401. }
  2402.  
  2403. not_unique();/* Print non-unique identifiers. */
  2404. }
  2405.  
  2406. ;
  2407.  
  2408.  
  2409.  
  2410. stck_ptr= stack+1;cur_name= name_dir;
  2411. cur_repl= CAST(text_pointer,text_info)->text_link+text_info;
  2412. cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
  2413. cur_mod= UNNAMED_MODULE;
  2414. params= cur_params= cur_global_params= global_params;
  2415. frz_params();
  2416.  
  2417. ;
  2418.  
  2419. {
  2420. sixteen_bits a;
  2421. text_pointer cur_text;
  2422. boolean is_def;
  2423.  
  2424.  
  2425. copying_macros= YES;
  2426.  
  2427. for(cur_text= text_info+1;cur_text<text_ptr;cur_text++)
  2428. if(cur_text->text_link==macro)
  2429. {/* |cur_text| is the text for a macro */
  2430. cur_byte= cur_text->tok_start;
  2431. cur_end= (cur_text+1)->tok_start;
  2432.  
  2433. is_WEB_macro= 
  2434. BOOLEAN(!((is_def= BOOLEAN(cur_text->nargs==OUTER_MACRO))||
  2435. cur_text->nargs==OUTER_UNMACRO));/* Check special \
  2436. marker set on input. */
  2437.  
  2438. if(is_WEB_macro)
  2439. {
  2440. #if(0)
  2441. see_macro(cur_byte,cur_end)/* For debugging. */
  2442. #endif
  2443. ;}
  2444. else
  2445.  
  2446. {
  2447. LANGUAGE language0;
  2448. T_OUTER*po= &t_style.outer_start[lan_num(language)];
  2449. outer_char*outer_macro;
  2450.  
  2451. out_state= MISCELLANEOUS;
  2452.  
  2453. set_output_file((LANGUAGE)cur_text->Language);/* Set the language for this \
  2454.                         outer macro.  */
  2455.  
  2456. protect= YES;/* New-lines should be preceded by the protection character. */
  2457.  
  2458. outer_macro= OC(is_def?po->def:po->undef);
  2459. language0= language;
  2460.  
  2461. C_sprintf(outer_macro,0);
  2462.  
  2463. stck_ptr= stack;
  2464. push_level(NULL,cur_byte,cur_end);
  2465.  
  2466. WHILE()
  2467.  
  2468. {
  2469. if(DONE_LEVEL&&!pop_level())break;
  2470.  
  2471. a= *cur_byte++;
  2472.  
  2473. if(cur_byte==cur_end&&a==012)
  2474. continue;/* disregard a final new-line */
  2475.  
  2476. if(TOKEN1(a))
  2477.  
  2478. {
  2479. send_single(a);
  2480. }
  2481.  
  2482.  
  2483. else
  2484. {
  2485. a= IDENTIFIER(a,*cur_byte++);
  2486.  
  2487. if(a<MODULE_NAME)
  2488. {
  2489. cur_val= a;
  2490. OUT_CHAR(identifier);/* Outer macro text will be expanded here. */
  2491. }
  2492. else if(a!=MODULE_NUM)
  2493. {
  2494. CONFUSION("copy outer","Macros defs have strange char");
  2495. }
  2496. else
  2497. {
  2498. cur_mod= a-MODULE_NUM;
  2499. cur_val= (long)cur_mod;
  2500. OUT_CHAR(module_number);
  2501. }
  2502. /* no other cases */
  2503. }
  2504. }
  2505.  
  2506.  
  2507.  
  2508. set_output_file(language0);
  2509.  
  2510. protect= NO;
  2511. flush_buffer();
  2512. }
  2513.  
  2514.  
  2515. }
  2516.  
  2517. copying_macros= NO;
  2518. }
  2519.  
  2520. ;
  2521.  
  2522.  
  2523.  
  2524. stck_ptr= stack+1;cur_name= name_dir;
  2525. cur_repl= CAST(text_pointer,text_info)->text_link+text_info;
  2526. cur_byte= cur_repl->tok_start;cur_end= (cur_repl+1)->tok_start;
  2527. cur_mod= UNNAMED_MODULE;
  2528. params= cur_params= cur_global_params= global_params;
  2529. frz_params();
  2530.  
  2531. ;
  2532.  
  2533. while(get_output())
  2534. ;/* Process each character of the output. */
  2535.  
  2536. flush_buffer();
  2537.  
  2538. if(compare_outfiles)
  2539. cmp_outfiles();/* Compare tangled output against old files. */
  2540.  
  2541. CLR_PRINTF(info,("\nDone."));
  2542. }
  2543. }
  2544.  
  2545.  
  2546. SRTN out_version FCN((msg))
  2547. CONST outer_char*msg C1("")
  2548. {
  2549. outer_char HUGE*temp= GET_MEM("version:temp",N_MSGBUF,outer_char);
  2550. boolean in_string0= in_string;
  2551. OUTPUT_STATE out_state0= out_state;
  2552.  
  2553.  
  2554. if(
  2555. nsprintf(temp,OC("  FTANGLE v%s, created with %s on \"%s, %s at %s.\" %s\n"),6,"1.40",the_system,"Saturday","October 30, 1993","13:15",local_banner)>=(int)(N_MSGBUF))OVERFLW("temp","");
  2556. STRCAT(temp,cmd_ln_buf);
  2557. STRCAT(temp,msg);/* Possible \.{@o} continuation message.i */
  2558. in_version= YES;
  2559. OUT_MSG(to_ASCII(temp),NULL);
  2560. FREE_MEM(temp,"version:temp",N_MSGBUF,outer_char);
  2561.  
  2562. in_version= NO;
  2563. in_string= in_string0;
  2564. out_state= out_state0;
  2565.  
  2566. if(line_info)
  2567. out_pos= 0;
  2568. else
  2569. {
  2570. started_vcmnt= NO;
  2571. rst_out(NOT_CONTINUATION);
  2572. }
  2573. }
  2574.  
  2575.  
  2576.  
  2577. SRTN i_version_ FCN((n,pargs))
  2578. int n C0("")
  2579. PARGS pargs C1("")
  2580. {
  2581. CHK_ARGS("$VERSION",0);
  2582.  
  2583. mcopy(version);
  2584. }
  2585.  
  2586.  
  2587.  
  2588. SRTN i_tm_ FCN((n,pargs))
  2589. int n C0("")
  2590. PARGS pargs C1("")
  2591. {
  2592. eight_bits HUGE*p;
  2593. struct tm*t;
  2594.  
  2595. CHK_ARGS("$TM",1);
  2596.  
  2597. p= pargs[0]+1;/* Should point to a single-digit constant. */
  2598.  
  2599. if(*p++!=constant)
  2600. {
  2601.  
  2602. macro_err(OC("Argument of $TM must be numerical constant"),YES);
  2603. return;
  2604. }
  2605.  
  2606. t= the_localtime();/* Fill the |tm| structure and return a pointer. */
  2607.  
  2608. switch(*p-060)
  2609. {/* Convert digit to integer and select routine. */
  2610. case 0:
  2611. mcopy(the_day(t));
  2612. break;
  2613.  
  2614. case 1:
  2615. /* The date needs to be protected because of the comma. */
  2616. MCHECK(2,"the_cdate");
  2617. *mp++= 0140;
  2618. mcopy(the_cdate(t));
  2619. *mp++= 0140;
  2620. break;
  2621.  
  2622. case 2:
  2623. mcopy(the_time(t));
  2624. break;
  2625.  
  2626. default:
  2627.  
  2628. macro_err(OC("Invalid case in _tm_"),YES);
  2629. break;
  2630. }
  2631. }
  2632.  
  2633.  
  2634.  
  2635. SRTN mcopy FCN((s))
  2636. CONST outer_char*s C1("")
  2637. {
  2638. int n= STRLEN(s);
  2639.  
  2640. MCHECK(n,"mcopy");
  2641. STRCPY(mp,x_to_ASCII(s));
  2642. mp+= n;
  2643. }
  2644.  
  2645.  
  2646.  
  2647. SRTN not_unique(VOID)
  2648. {
  2649. TRUNC HUGE*s,HUGE*HUGE*ss,HUGE*HUGE*ss0,HUGE*HUGE*ss1;
  2650. LANGUAGE Language;
  2651. int l;
  2652. size_t n;/* Counts number of non-unique variables. */
  2653. size_t num_max;/* Maximum \# of roots for any duplicate. */
  2654. BP HUGE*HUGE*bb0;
  2655. boolean found_dup= NO;
  2656.  
  2657. for(l= 0;l<NUM_LANGUAGES;l++)
  2658. {
  2659. Language= lan_enum(l);
  2660.  
  2661. /* Count the number of duplicate variables. */
  2662. n= 0;
  2663.  
  2664. for(s= &sh;s->next;s= s->next)
  2665. {
  2666. if(!((boolean)s->Language&(boolean)Language))continue;
  2667.  
  2668. if(s->num[l]>1)
  2669. {
  2670. char temp[10];
  2671. unsigned len= tr_max[l];
  2672.  
  2673. sprintf(temp,len?"%u":"*",len);
  2674.  
  2675. if(n==0)
  2676. {
  2677. printf("\n\n%c! Non-unique \
  2678. %s variables (filtered with {%s}, truncated to length %s):",
  2679. beep(1),languages[l],filter_char[l],temp);
  2680. found_dup= YES;
  2681. }
  2682. n++;
  2683. }
  2684. }
  2685.  
  2686. if(n==0)continue;
  2687.  
  2688. /* Store the pointers to the duplicates in an array. */
  2689. ss1= ss0= ss= GET_MEM("ss",n,TRUNC HUGE*);
  2690. num_max= 0;
  2691.  
  2692. for(s= &sh;s->next;s= s->next)
  2693. {
  2694. if(!((boolean)s->Language&(boolean)Language))continue;
  2695.  
  2696. if(s->num[l]>1)
  2697. {
  2698. *ss++= s;
  2699. num_max= MAX(num_max,s->num[l]);
  2700. }
  2701. }
  2702.  
  2703. /* Sort the array. */
  2704. QSORT(ss0,n,sizeof(TRUNC HUGE*),cmpr_trunc);
  2705.  
  2706. /* Print out the sorted array. */
  2707. bb0= GET_MEM("bb",num_max,BP HUGE*);
  2708.  
  2709. while(ss1<ss)
  2710. see_dup(*ss1++,Language,bb0);
  2711.  
  2712. FREE_MEM(ss0,"ss",n,TRUNC HUGE*);
  2713. FREE_MEM(bb0,"bb",num_max,BP HUGE*);
  2714. }
  2715.  
  2716. if(found_dup)
  2717. NEWLINE;
  2718. }
  2719.  
  2720. SRTN see_dup FCN((s,Language,bb0))
  2721. CONST TRUNC HUGE*s C0("")
  2722. LANGUAGE Language C0("")
  2723. BP HUGE*HUGE*bb0 C1("")
  2724. {
  2725. BP HUGE*b,HUGE*HUGE*bb,HUGE*HUGE*bb1;
  2726. int n;
  2727.  
  2728. NEWLINE;
  2729. printf(" ");
  2730. n= see(s->id,s->id_end);/* The truncated id. */
  2731.  
  2732. /* Space it out so it looks nicely lined up. */
  2733. for(n= tr_max[lan_num(Language)]+1-n;n>0;n--)printf(" ");
  2734. printf("<=");
  2735.  
  2736. /* Print all back references to original variables. */
  2737. for(b= s->first,bb= bb0;b!=NULL;b= b->next)
  2738. {
  2739. if(!((boolean)b->Language&(boolean)Language))continue;
  2740.  
  2741. *bb++= b;
  2742. }
  2743.  
  2744. QSORT(bb0,bb-bb0,sizeof(BP HUGE*),cmpr_bp);
  2745.  
  2746. for(bb1= bb0;bb1<bb;bb1++)
  2747. {
  2748. printf(" ");
  2749. see((*bb1)->byte_start,(*bb1)->byte_end);
  2750. }
  2751. }
  2752.  
  2753. int see FCN((c0,c1))
  2754. CONST ASCII HUGE*c0 C0("Beginning.")
  2755. CONST ASCII HUGE*c1 C1("end.")
  2756. {
  2757. int n= c1-c0;
  2758.  
  2759. while(c0<c1)printf("%c",XCHR(*c0++));
  2760.  
  2761. return n;/* Length of identifier. */
  2762. }
  2763.  
  2764.  
  2765.  
  2766. int cmpr_trunc FCN((t0,t1))
  2767. TRUNC HUGE**t0 C0("")
  2768. TRUNC HUGE**t1 C1("")
  2769. {
  2770. switch(web_strcmp((*t0)->id,(*t0)->id_end,(*t1)->id,(*t1)->id_end))
  2771. {
  2772. case EQUAL:
  2773. return 0;
  2774.  
  2775. case LESS:
  2776. case PREFIX:
  2777. return-1;
  2778.  
  2779. case GREATER:
  2780. case EXTENSION:
  2781. return 1;
  2782. }
  2783.  
  2784. return 0;
  2785. }
  2786.  
  2787. int cmpr_bp FCN((bb0,bb1))
  2788. BP HUGE**bb0 C0("")
  2789. BP HUGE**bb1 C1("")
  2790. {
  2791. switch(web_strcmp((*bb0)->byte_start,(*bb0)->byte_end,
  2792. (*bb1)->byte_start,(*bb1)->byte_end))
  2793. {
  2794. case EQUAL:
  2795. return 0;
  2796.  
  2797. case LESS:
  2798. case PREFIX:
  2799. return-1;
  2800.  
  2801. case GREATER:
  2802. case EXTENSION:
  2803. return 1;
  2804. }
  2805.  
  2806. return 0;
  2807. }
  2808.  
  2809.  
  2810.  
  2811. BP HUGE*b_link FCN((s,Language,p0,p1))
  2812. TRUNC HUGE*s C0("")
  2813. LANGUAGE Language C0("")
  2814. CONST ASCII HUGE*p0 C0("")
  2815. CONST ASCII HUGE*p1 C1("")
  2816. {
  2817. BP HUGE*bp;
  2818.  
  2819. bp= GET_MEM("bp",1,BP);/* Get a back-pointer structure. */
  2820.  
  2821. bp->c= BP_MARKER;
  2822.  
  2823. /* Remember language of original variable. */
  2824. bp->Language= Language;
  2825.  
  2826. /* Record start and end of the original name. */
  2827. bp->byte_start= p0;
  2828. bp->byte_end= p1;
  2829.  
  2830. /* Link back to original |TRUNC| structure. */
  2831. bp->Root= s;
  2832. s->Language|= (boolean)Language;
  2833. s->num[lan_num(Language)]++;/* Count hits for this language. */
  2834.  
  2835. return bp;
  2836. }
  2837.  
  2838.  
  2839.  
  2840. TRUNC HUGE*s_link FCN((s,id,len))
  2841. TRUNC HUGE*s C0("Points to the current structure, to be \
  2842. filled with info.")
  2843. CONST ASCII HUGE*id C0("Truncated identifier.")
  2844. unsigned short len C1("Length of truncated identifier.")
  2845. {
  2846. /* Fill this structure with truncated variable name. */
  2847. s->id= GET_MEM("s->id",len,ASCII);/* Space for name. */
  2848. STRNCPY(s->id,id,len);/* Copy over name. */
  2849. s->id_end= s->id+len;/* End of name. */
  2850.  
  2851. /* Attach another (uninitialized) structure. */
  2852. s->next= GET_MEM("s->next",1,TRUNC);
  2853.  
  2854. return s;
  2855. }
  2856.  
  2857.  
  2858.  
  2859. name_pointer id0_lookup FCN((start,end,l))
  2860. CONST ASCII HUGE*start C0("Start of name.")
  2861. CONST ASCII HUGE*end C0("end of name.")
  2862. LANGUAGE l C1("")
  2863. {
  2864. name_pointer np;
  2865. CONST ASCII HUGE*p0,HUGE*p1;
  2866.  
  2867. for(np= name_dir+1;np<name_ptr;np++)
  2868. {
  2869. if(!(np->Language&(boolean)l)||
  2870. np->equiv!=NULL||*(p0= np->byte_start)==BP_MARKER)
  2871. continue;
  2872.  
  2873. PROPER_END(p1);
  2874.  
  2875. if(web_strcmp(p0,p1,start,end)==EQUAL)
  2876. return np;
  2877. }
  2878.  
  2879. return NULL;
  2880. }
  2881.  
  2882.  
  2883.  
  2884. unsigned trunc_id FCN((np0))
  2885. CONST name_pointer np0 C1("Points to current id structure.")
  2886. {
  2887. CONST ASCII HUGE*p,HUGE*p0,HUGE*p1;/* For original identifier. */
  2888. ASCII temp[N_IDBUF];
  2889. ASCII HUGE*t;/* For truncated identifier. */
  2890. unsigned short n;/* Length of truncated identifier. */
  2891. TRUNC HUGE*s;
  2892. name_pointer np;
  2893. unsigned short nmax;/* Truncate to this length. */
  2894. LANGUAGE Language;
  2895. int l;
  2896. unsigned count= 0;
  2897.  
  2898. if(np0->Language==(boolean)NO_LANGUAGE||np0->equiv!=NULL)
  2899. return 0;
  2900.  
  2901. for(l= 0;l<NUM_LANGUAGES;l++)
  2902. {
  2903. Language= lan_enum(l);
  2904. np= np0;
  2905.  
  2906. /* Don't bother with it if there's no truncation specified for this \
  2907. language, if it's not in use for this language, if it's a reserved word, \
  2908. intrinsic word, or keyword, or if it's a \WEB\ macro. */
  2909. if((nmax= tr_max[l])==0||!(np->Language&(boolean)Language)
  2910. ||(np->reserved_word&(boolean)Language)
  2911. ||(np->intrinsic_word&(boolean)Language)
  2912. ||(np->keyword&(boolean)Language)
  2913. ||(np->macro_type!=NOT_DEFINED))
  2914. continue;
  2915.  
  2916. /* The original name. */
  2917. p0= np->byte_start;
  2918.  
  2919. if(*p0==BP_MARKER)
  2920. continue;/* NEED MORE WORK HERE (variable already deflected). */
  2921.  
  2922. PROPER_END(p1);
  2923.  
  2924. /* Filter. */
  2925. for(p= p0,t= temp,n= 0;p<p1&&n<nmax;p++)
  2926. if(STRCHR(filter_char[l],(int)XCHR(*p))==NULL)
  2927. {
  2928. n++;
  2929. *t++= *p;
  2930. }
  2931.  
  2932. n= t-temp;/* Length of truncated identifier. */
  2933.  
  2934. if(p1-p0==(long)n)
  2935. continue;/* Not truncated; nothing to do. */
  2936.  
  2937. count++;/* Count number of truncations for this identifier. */
  2938.  
  2939. /* Is the truncated name already in the list? */
  2940. for(s= &sh;s->next!=NULL;s= s->next)
  2941. if(s->id_end-s->id==(long)n&&
  2942. web_strcmp(s->id,s->id_end,temp,t)==EQUAL)
  2943. {
  2944. another_bp:
  2945. s->last= s->last->next= b_link(s,Language,p0,p1);
  2946. /* Remember the original variable by attaching another back reference. */
  2947. np->byte_start= (ASCII*)s->last;/* Deflect original ptr. */
  2948. goto next_language;
  2949. }
  2950.  
  2951. /* Add a new name to the list. */
  2952. s= s_link(s,temp,n);
  2953. s->first= s->last= b_link(s,Language,p0,p1);/* Attach first back reference. */
  2954. np->byte_start= (ASCII*)s->first;/* Deflect original ptr. */
  2955.  
  2956. /* If the truncated name was in the original list, not previously truncated \
  2957. from something else, put the original name into the truncated list. */
  2958. if((np= id0_lookup(temp,t,(LANGUAGE)np->Language))!=NULL)
  2959. {
  2960. p0= np->byte_start;PROPER_END(p1);
  2961. goto another_bp;
  2962. }
  2963.  
  2964. next_language:;
  2965. }
  2966.  
  2967. return count;
  2968. }
  2969.  
  2970.  
  2971.  
  2972. SRTN open_out FCN((msg,global_scope))
  2973. CONST outer_char*msg C0("")
  2974. boolean global_scope C1("")
  2975. {
  2976. boolean is_stdout= BOOLEAN(STRCMP(params.OUTPUT_FILE_NAME,"stdout")==0);
  2977. boolean already_opened= NO;
  2978.  
  2979. if(is_stdout)
  2980. out_file= params.OUT_FILE= stdout;
  2981. else
  2982. {
  2983. already_opened= was_opened(params.OUTPUT_FILE_NAME,global_scope,
  2984. NULL,&out_file);
  2985.  
  2986. params.OUT_FILE= out_file;/* Local output file. */
  2987.  
  2988. /* Write header info to the newly opened file. (We don't write it for \
  2989. |stdout|, because it clutters up the screen.) */
  2990. if(top_version&&!(already_opened||compare_outfiles))
  2991. out_version(msg);
  2992. }
  2993.  
  2994. /* The first time a file is opened for a particular language, its |FILE| \
  2995. pointer must be made global so it can be restored at the beginning of each \
  2996. module.  (The name was already made global in |common_init|.) */
  2997. if(global_scope)
  2998. cur_global_params.OUT_FILE= global_params.OUT_FILE= out_file;
  2999.  
  3000. /* The first time a file is opened, write its name to the screen. */
  3001. if(!already_opened)
  3002. {
  3003. CLR_PRINTF(out_file,("(%s)%s",params.OUTPUT_FILE_NAME,is_stdout?"\n":""));
  3004. UPDATE_TERMINAL;
  3005. }
  3006. }
  3007.  
  3008.  
  3009.  
  3010. boolean was_opened FCN((file_name,global_scope,pname,pfile_ptr))
  3011. CONST outer_char HUGE*file_name C0("")
  3012. boolean global_scope C0("")
  3013. outer_char HUGE*HUGE*pname C0("")
  3014. FILE**pfile_ptr C1("")
  3015. {
  3016. OPEN_FILE HUGE*f;
  3017.  
  3018. if(!*file_name)
  3019. {/* Take care of special cases called by |xpn_name|. */
  3020. *pname= (outer_char HUGE*)"";
  3021. *pfile_ptr= NULL;
  3022. return NO;
  3023. }
  3024.  
  3025. /* Is file already in the list of previously opened? */
  3026. for(f= open_file;f<last_file;f++)
  3027. if(STRCMP(f->name,file_name)==0)
  3028. {
  3029. if(pname)
  3030. {/* Just return (to |new_fname|) some information. */
  3031. *pname= f->name;
  3032. *pfile_ptr= f->ptr;
  3033. return f->previously_opened;
  3034. }
  3035. else
  3036. goto open_it;
  3037. }
  3038.  
  3039.  
  3040. {
  3041. /* File not in list; is there room for more? */
  3042. if(last_file==open_file_end)
  3043. {
  3044. OVERFLW("previously opened files","nf");
  3045. }
  3046.  
  3047. last_file->name= GET_MEM("last_file",STRLEN(file_name)+1,outer_char);
  3048. STRCPY(last_file->name,file_name);
  3049. last_file++;
  3050. }
  3051.  
  3052.  
  3053.  
  3054. if(pname)
  3055. {/* File wasn't previously opened, and has now been added to list \
  3056. of file names. */
  3057. *pname= f->name;
  3058. f->ptr= NULL;
  3059. f->previously_opened= NO;
  3060. f->global_scope= global_scope;
  3061. }
  3062. else
  3063.  
  3064. {
  3065. open_it:
  3066. f->previously_opened= BOOLEAN(f->previously_opened||(f->ptr!=NULL));
  3067.  
  3068. if(f->previously_opened)
  3069. {/* It might have been once opened, but then closed. */
  3070. if(f->ptr==NULL)
  3071. f->ptr= FOPEN(compare_outfiles?f->tmp_name:f->name,"a");
  3072. }
  3073. else
  3074. {/* File wasn't ever opened. */
  3075. if(compare_outfiles)
  3076.  
  3077. {
  3078. char*buffer;
  3079. IN_COMMON outer_char wbprefix[MAX_FILE_NAME_LENGTH];
  3080.  
  3081. #if(HAVE_TEMPNAM)
  3082. extern char*tempnam();
  3083.  
  3084. if(!*wbprefix)STRCPY(wbprefix,"./");
  3085. buffer= tempnam(wbprefix,"FTMP");
  3086. /* Non-|ANSI|, but more control over directory. */
  3087. #else
  3088. buffer= tmpnam(NULL);/* |ANSI| routine. */
  3089. #endif
  3090.  
  3091. f->tmp_name= GET_MEM("f->tmp_name",STRLEN(buffer)+1,outer_char);
  3092.  
  3093. STRCPY(f->tmp_name,buffer);
  3094.  
  3095. f->ptr= FOPEN(f->tmp_name,"w");
  3096. }
  3097.  
  3098.  
  3099. else
  3100. f->ptr= FOPEN(f->name,"w");
  3101.  
  3102. if(!(f->ptr))
  3103. {/* Should upgrade this message. */
  3104. FATAL("\n!! Can't open output file ",file_name);
  3105. }
  3106. }
  3107. }
  3108.  
  3109.  
  3110.  
  3111. *pfile_ptr= f->ptr;
  3112. return f->previously_opened;
  3113. }
  3114.  
  3115.  
  3116.  
  3117. SRTN close_out FCN((fp))
  3118. FILE*fp C1("")
  3119. {
  3120. OPEN_FILE*f;
  3121.  
  3122. for(f= open_file;f<last_file;f++)
  3123. if(f->ptr==fp)
  3124. {
  3125. close0(f);
  3126. return;
  3127. }
  3128.  
  3129. CONFUSION("close_out","Allegedly open file isn't in list");
  3130. }
  3131.  
  3132.  
  3133.  
  3134. SRTN cls_local(VOID)
  3135. {
  3136. OPEN_FILE*f;
  3137.  
  3138. for(f= open_file;f<last_file;f++)
  3139. if(f->ptr&&!f->global_scope)
  3140. close0(f);
  3141. }
  3142.  
  3143.  
  3144. SRTN close0 FCN((f))
  3145. OPEN_FILE*f C1("")
  3146. {
  3147. fclose(f->ptr);
  3148. f->ptr= NULL;
  3149. f->previously_opened= YES;
  3150. }
  3151.  
  3152.  
  3153. SRTN cmp_outfiles(VOID)
  3154. {
  3155. OPEN_FILE*f;
  3156. boolean renamed= NO;
  3157.  
  3158. printf("\nRenaming temporary file(s):  ");
  3159. UPDATE_TERMINAL;
  3160.  
  3161. for(f= open_file;f<last_file;f++)
  3162. if(f->previously_opened||f->ptr)
  3163. {
  3164. FILE*old_ptr= FOPEN(f->name,"r");
  3165.  
  3166. if(f->ptr)
  3167. fflush(f->ptr);
  3168.  
  3169. if(old_ptr)
  3170.  
  3171. {
  3172. int c_old,c_new;
  3173. FILE*new_ptr;
  3174.  
  3175. if(f->ptr)
  3176. new_ptr= freopen((CONST char*)f->tmp_name,"r",f->ptr);
  3177. else
  3178. new_ptr= FOPEN(f->tmp_name,"r");
  3179.  
  3180. if(!new_ptr)
  3181. FATAL("\n!! Can't reopen temporary file ",f->tmp_name);
  3182.  
  3183. do
  3184. {
  3185. c_old= getc(old_ptr);
  3186. c_new= getc(new_ptr);
  3187. }
  3188. while(c_old==c_new&&c_old!=EOF);
  3189.  
  3190. fclose(old_ptr);
  3191. fclose(new_ptr);
  3192.  
  3193. if(c_old==c_new)
  3194. remove((CONST char*)f->tmp_name);/* Harmless if this doesn't work. */
  3195. else
  3196.  
  3197. {
  3198. /* Try to ensure that the following |rename| will succeed. */
  3199. remove((CONST char*)f->name);
  3200.  
  3201. printf("(%s",f->name);/* Echo to terminal. */
  3202.  
  3203. if(rename((CONST char*)f->tmp_name,(CONST char*)f->name)!=0)
  3204. {/* Rename didn't work.  Attempt to force the rename by issuing a \
  3205. \.{mv} command.  The actual name of the command is obtained from the \
  3206. preprocessor variable |MV|, which is defined on the command line and whose \
  3207. value is ultimately defined in \.{defaults.mk}. */
  3208. #if ANSI_SYSTEM
  3209. if(!system(NULL))
  3210. {/* No command processor! */
  3211.  
  3212. err0_print(ERR_T,OC("Couldn't rename \"%s\" to \"%s\""),2,f->tmp_name,f->name);
  3213. perror("");
  3214. }
  3215. else
  3216. #endif /* |ANSI_SYSTEM| */
  3217. {
  3218. char temp[256];
  3219.  
  3220. /* We put the following here in case for some reason the make file can't \
  3221. define |MV|.  This is the case with some versions of \.{nmake} on the PC. */
  3222. #ifndef MV
  3223. #ifdef ibmpc
  3224. #define MV rename
  3225. #else
  3226. #define MV mv
  3227. #endif
  3228. #endif
  3229. sprintf(temp,"%s %s %s","MV",f->tmp_name,f->name);
  3230. system(temp);
  3231. printf("*");/* Indicate a copy was done. */
  3232. }
  3233. }
  3234.  
  3235. printf(")");UPDATE_TERMINAL;
  3236.  
  3237. renamed= YES;
  3238. }
  3239.  
  3240.  
  3241. }
  3242.  
  3243.  
  3244. else
  3245.  
  3246. {
  3247. /* Try to ensure that the following |rename| will succeed. */
  3248. remove((CONST char*)f->name);
  3249.  
  3250. printf("(%s",f->name);/* Echo to terminal. */
  3251.  
  3252. if(rename((CONST char*)f->tmp_name,(CONST char*)f->name)!=0)
  3253. {/* Rename didn't work.  Attempt to force the rename by issuing a \
  3254. \.{mv} command.  The actual name of the command is obtained from the \
  3255. preprocessor variable |MV|, which is defined on the command line and whose \
  3256. value is ultimately defined in \.{defaults.mk}. */
  3257. #if ANSI_SYSTEM
  3258. if(!system(NULL))
  3259. {/* No command processor! */
  3260.  
  3261. err0_print(ERR_T,OC("Couldn't rename \"%s\" to \"%s\""),2,f->tmp_name,f->name);
  3262. perror("");
  3263. }
  3264. else
  3265. #endif /* |ANSI_SYSTEM| */
  3266. {
  3267. char temp[256];
  3268.  
  3269. /* We put the following here in case for some reason the make file can't \
  3270. define |MV|.  This is the case with some versions of \.{nmake} on the PC. */
  3271. #ifndef MV
  3272. #ifdef ibmpc
  3273. #define MV rename
  3274. #else
  3275. #define MV mv
  3276. #endif
  3277. #endif
  3278. sprintf(temp,"%s %s %s","MV",f->tmp_name,f->name);
  3279. system(temp);
  3280. printf("*");/* Indicate a copy was done. */
  3281. }
  3282. }
  3283.  
  3284. printf(")");UPDATE_TERMINAL;
  3285.  
  3286. renamed= YES;
  3287. }
  3288.  
  3289. /* No old file at all. */
  3290. }
  3291.  
  3292. if(!renamed)
  3293. printf("[no changes]");
  3294. }
  3295.  
  3296.  
  3297.  
  3298. SRTN out_op FCN((s))
  3299. CONST outer_char HUGE*s C1("String to translate.")
  3300. {
  3301. out_str(s);
  3302.  
  3303. out_state= MISCELLANEOUS;
  3304. }
  3305.  
  3306. SRTN out_str FCN((s))
  3307. CONST outer_char HUGE*s C1("")
  3308. {
  3309. while(*s)
  3310. C_putc(*s++);
  3311. }
  3312.  
  3313.  
  3314.  
  3315. eight_bits x_identifier FCN((cur_char))
  3316. eight_bits cur_char C1("")
  3317. {
  3318.  
  3319. {
  3320. boolean in_macro0= in_macro;
  3321. name_pointer np= name_dir+cur_val;
  3322. X_FCN(HUGE_FCN_PTR*pf)(VOID);/* The function associated with expandable \
  3323.                     keywords. */
  3324.  
  3325. if(np->expandable&language)
  3326. {
  3327. expand_special:
  3328. in_macro= NO;/* Don't suppress recursive expansion of macros. */
  3329.  
  3330. pf= np->x_translate[lan_num(language)];
  3331.  
  3332. if(pf)(*pf)();/* Expand keyword. */
  3333. else CONFUSION("possibly expand special",
  3334. "Allegedly expandable keyword has no associated function");
  3335.  
  3336. in_macro= in_macro0;
  3337.  
  3338. cur_char= id_keyword;/* Helps \Ratfor\ know what happened. */
  3339. goto end_identifier;
  3340. }
  3341. else if(R77&&Fortran88&&!checking_label)
  3342. switch(chk_lbl())
  3343. {
  3344. case YES:goto expand_special;
  3345. case-1:goto end_identifier;
  3346. case NO:break;
  3347. }
  3348. }
  3349.  
  3350. ;
  3351.  
  3352. if(is_deferred((sixteen_bits)cur_val))return cur_char;
  3353.  
  3354. /* |MAC_LOOKUP| determines whether this is a WEB macro. Eventually, this \
  3355. routine will be called recursively to output the expansion. The |in_macro| \
  3356. flag prevents us from checking the expanded tokens again, since everything \
  3357. will already have been expanded. */
  3358. if(!mac_protected&&(macro_text= MAC_LOOKUP(cur_val))!=NULL)
  3359. {
  3360.  
  3361. {
  3362. eight_bits HUGE*p1;
  3363.  
  3364.  
  3365. in_macro= YES;/* Used as a flag to prevent |MAC_LOOKUP| on \
  3366.     recursive |out_char| output of the final translated macro. */
  3367.  
  3368. p1= xmacro(macro_text,&cur_byte,cur_end,macrobuf);/* Expand this \
  3369.     macro into the macro buffer. The final expansion will begin at |p1| \
  3370.     and end at~|mp|. */
  3371.  
  3372. /* Output final translated text, which begins at the end~|p1| of the last \
  3373. translation and ends at the current value of~|mp|. This calls |out_char| \
  3374. recursively.  */
  3375. copy_out(p1,mp,macro);
  3376. in_macro= NO;
  3377. }
  3378.  
  3379.  
  3380. return cur_char;
  3381. }
  3382. else
  3383. {/* Not a macro. */
  3384.  
  3385. {
  3386. #if FANCY_SPLIT
  3387. if(C_LIKE(language)&&out_state!=VERBATIM)
  3388. split_pos= pC_buffer;
  3389. #endif /* |FANCY_SPLIT| */
  3390. }
  3391.  
  3392.  
  3393. if(out_state==NUM_OR_ID&&!nuweb_mode)
  3394. C_putc(' ');
  3395.  
  3396.  
  3397. {
  3398. name_pointer np;
  3399.  
  3400.  
  3401. np= name_dir+cur_val;
  3402.  
  3403. if(truncate_ids)
  3404. out_trunc(np);
  3405. else
  3406. see_id(np->byte_start,(np+1)->byte_start);
  3407. }
  3408.  
  3409. ;
  3410.  
  3411. if(no_expand)
  3412. no_expand= mac_protected= NO;
  3413. }
  3414.  
  3415. end_identifier:
  3416. out_state= in_format?MISCELLANEOUS:NUM_OR_ID;
  3417.  
  3418. return cur_char;
  3419. }
  3420.  
  3421.  
  3422.  
  3423. boolean is_deferred FCN((cur_val))
  3424. sixteen_bits cur_val C1("")
  3425. {
  3426. name_pointer np;
  3427.  
  3428. np= name_dir+cur_val;
  3429.  
  3430. if(np->macro_type==DEFERRED_MACRO)
  3431. {
  3432. text_pointer tp;
  3433. eight_bits HUGE*p0;
  3434. eight_bits a0;
  3435.  
  3436. tp= (text_pointer)np->equiv;/* Position in the deferred pool. */
  3437.  
  3438. /* Copy the tokens of the definition over into the next text. */
  3439. for(p0= tp->tok_start;p0<(tp+1)->tok_start;)
  3440. if(TOKEN1(a0= *p0++))
  3441. if(a0==043)
  3442. switch(*p0)
  3443. {
  3444. case 041:
  3445. if(*(p0+1)==MACRO_ARGUMENT)
  3446. app_repl(a0)
  3447. else
  3448. {
  3449. if(TOKEN1(*++p0))
  3450. macro_err(OC("! Macro token `#!' must be followed by \
  3451. identifier"),YES);
  3452. else
  3453. {
  3454. text_pointer m;
  3455.  
  3456. if((m= MAC_LOOKUP(IDENTIFIER(*p0,*(p0+1))))==NULL)
  3457.  
  3458. macro_err(OC("! Expecting macro identifier after \"#!\""),YES);
  3459. else
  3460. if(m->nargs>0)
  3461.  
  3462. macro_err(OC("! Macro after \"#!\" can't have arguments"),YES);
  3463. else
  3464. {
  3465. eight_bits HUGE*q0,HUGE*q1;
  3466.  
  3467.  
  3468. q0= m->tok_start+m->moffset;
  3469. q1= (m+1)->tok_start;
  3470.  
  3471. /* Just copy the definition without expanding. */
  3472. while(q0<q1)app_repl(*q0++);
  3473. }
  3474.  
  3475.  
  3476.  
  3477. p0+= 2;
  3478. }
  3479. }
  3480.  
  3481.  
  3482. break;
  3483.  
  3484. default:
  3485. app_repl(a0);
  3486. break;
  3487. }
  3488. else app_repl(a0)/* Single token, not special. */
  3489. else
  3490. {
  3491. app_repl(a0);
  3492. app_repl(*p0++);
  3493. }
  3494.  
  3495. cur_text= text_ptr;
  3496. cur_text->Language= (boolean)language;
  3497. cur_text->nargs= tp->nargs;
  3498. cur_text->moffset= tp->moffset;
  3499. cur_text->var_args= tp->var_args;
  3500. cur_text->recursive= NO;
  3501. cur_text->text_link= macro;
  3502.  
  3503. (++text_ptr)->tok_start= tok_ptr;
  3504.  
  3505. np= name_dir+IDENTIFIER(tp->tok_start[0],tp->tok_start[1]);
  3506. np->macro_type= IMMEDIATE_MACRO;/* Now the defn's been executed. */
  3507. np->equiv= (EQUIV)cur_text;
  3508.  
  3509. return YES;/* It's a deferred macro. */
  3510. }
  3511.  
  3512. return NO;/* Not a deferred macro. */
  3513. }
  3514.  
  3515.  
  3516.  
  3517. SRTN out_ptrunc FCN((cur_val))
  3518. sixteen_bits cur_val C1("")
  3519. {
  3520.  
  3521. {
  3522. name_pointer np;
  3523.  
  3524.  
  3525. np= name_dir+cur_val;
  3526.  
  3527. if(truncate_ids)
  3528. out_trunc(np);
  3529. else
  3530. see_id(np->byte_start,(np+1)->byte_start);
  3531. }
  3532.  
  3533.  
  3534. }
  3535.  
  3536.  
  3537.  
  3538. SRTN see_id FCN((start,end))
  3539. CONST ASCII HUGE*start C0("Beginning of identifier name.")
  3540. CONST ASCII HUGE*end C1("End of identifier name.")
  3541. {
  3542. CONST ASCII HUGE*j;
  3543.  
  3544. for(j= start;j<end;j++)C_putc(XCHR(*j));
  3545. }
  3546.  
  3547.  
  3548.  
  3549. int id FCN((n))
  3550. int n C1("Identifier number.")
  3551. {
  3552. printf(_Xx("Id %d (0x%x): \"%s\"\n"),n,n,name_of((sixteen_bits)n));
  3553. return n;
  3554. }
  3555.  
  3556.  
  3557.  
  3558. outer_char HUGE*name_of FCN((id0))
  3559. sixteen_bits id0 C1("Identifier token whose name is sought.")
  3560. {
  3561. static ASCII temp[MAX_ID_LENGTH];
  3562. int k,n;
  3563. name_pointer np;
  3564. CONST ASCII HUGE*end;
  3565.  
  3566. np= name_dir+id0;
  3567.  
  3568. /* Don't choke on bad id. */
  3569. if(np>=name_ptr)
  3570. {
  3571. STRCPY(temp,"???");
  3572. return(outer_char HUGE*)temp;
  3573. }
  3574.  
  3575. PROPER_END(end);
  3576.  
  3577. #if 0 /* This construction gives a compiler error on the IBM/6000. */
  3578. n= MIN(end-np->byte_start,MAX_ID_LENGTH-1);
  3579. #else
  3580. if(end-np->byte_start<MAX_ID_LENGTH-1)
  3581. n= end-np->byte_start;
  3582. else
  3583. n= MAX_ID_LENGTH-1;
  3584. #endif
  3585.  
  3586. STRNCPY(temp,np->byte_start,n);
  3587.  
  3588. /* We must be careful when breakpointing; backslashes must be escaped. */
  3589. if(breakpoints)
  3590. for(k= 0;k<n;k++)
  3591. if(temp[k]==0134)temp[k]= 057;
  3592.  
  3593. temp[n]= '\0';
  3594.  
  3595. return to_outer(temp);
  3596. }
  3597.  
  3598.  
  3599.  
  3600. CONST ASCII HUGE*proper_end FCN((np))
  3601. name_pointer np C1("")
  3602. {
  3603. CONST ASCII HUGE*end;
  3604.  
  3605. PROPER_END(end);
  3606. return end;
  3607. }
  3608.  
  3609. SRTN out_trunc FCN((np))
  3610. CONST name_pointer np C1("")
  3611. {
  3612. TRUNC HUGE*s;
  3613. ASCII HUGE*pc;
  3614.  
  3615. pc= np->byte_start;
  3616.  
  3617. if(*pc!=BP_MARKER)
  3618. {/* Not truncated. */
  3619. CONST ASCII HUGE*end;
  3620.  
  3621. /* If the next one was truncated, recover the proper end location. */
  3622. PROPER_END(end);
  3623. see_id((CONST ASCII HUGE*)pc,end);
  3624. }
  3625. else
  3626. {/* Truncated. */
  3627. s= ((BP HUGE*)pc)->Root;
  3628. see_id(s->id,s->id_end);
  3629. }
  3630. }
  3631.  
  3632.  
  3633.  
  3634. SRTN prn_mod_num FCN((fmt,val))
  3635. outer_char*fmt C0("")
  3636. long val C1("")
  3637. {
  3638. int l;
  3639.  
  3640. if(line_info)
  3641. {
  3642. l= lan_num(R77_or_F&&!free_90?FORTRAN:language);
  3643.  
  3644. if(val<0)
  3645. {/* Ending a section. */
  3646. val= -val;
  3647. }
  3648.  
  3649. if(FORTRAN_LIKE(language))
  3650. {
  3651. if(out_pos>rst_pos)flush_out(YES);
  3652. out_pos= 0;
  3653. }
  3654.  
  3655. C_sprintf(fmt,3,begin_comment_char[l],val,end_comment_char[l]);
  3656. }
  3657. }
  3658.  
  3659.  
  3660.  
  3661. eight_bits skip_ahead FCN((last_control,skip_over_bars))
  3662. eight_bits last_control C0("Last token that was seen.")
  3663. boolean skip_over_bars C1("")
  3664. {
  3665. eight_bits cc;/* Control code found. */
  3666. int ncc= 0;/* A counter that counts the \.{@}s; \
  3667.         used to figure out whether to ignore section \
  3668.         names immediately after \.{@f}. */
  3669. ASCII last_char;
  3670. ASCII HUGE*lc;
  3671. ASCII HUGE*l1= limit+1;
  3672.  
  3673. WHILE()
  3674. {
  3675. if(loc>limit)
  3676. {
  3677. another_line:
  3678. if(from_buffer)
  3679. {
  3680. undivert();/* Switch back to reading from files. */
  3681. return ignore;
  3682. }
  3683. else
  3684. {
  3685. if(!get_line())
  3686. return new_module;
  3687.  
  3688. l1= limit+1;
  3689. }
  3690. }
  3691.  
  3692. *l1= 0100;/* Barrier to stop high-speed scan through line. */
  3693.  
  3694. more_stuff:
  3695. switch(*loc)
  3696. {
  3697. case 0100:
  3698. break;
  3699.  
  3700. case 0174:
  3701. if(skip_over_bars)
  3702. {
  3703. if(skip_bars()==new_module)return new_module;
  3704. /* It's now positioned after the bar. */
  3705. continue;
  3706. }
  3707.  
  3708. /* Otherwise, we're in limbo or scanning control text; just keep going. */
  3709.  
  3710. default:
  3711. loc++;
  3712. if(loc>limit)
  3713. {
  3714. ncc= 2;
  3715. goto another_line;
  3716. }
  3717. goto more_stuff;
  3718. }
  3719.  
  3720. *l1= 040;/* Reset line terminator. */
  3721.  
  3722. if(loc>limit)ncc= 2;
  3723. else
  3724. {
  3725. last_char= 040;/* Get the last non-blank character before this control code. */
  3726.  
  3727. for(lc= loc-1;lc>=cur_buffer;lc--)
  3728. if(*lc!=040)
  3729. {
  3730. last_char= *lc;/* This might be a vertical bar. */
  3731. break;
  3732. }
  3733.  
  3734. ++loc;/* Position to after the~\.{@}. */
  3735. ++ncc;/* Count the \.{@}s. */
  3736.  
  3737. switch(cc= ccode[*(loc++)])
  3738. {/* Position to after \.{@?}. */
  3739.  
  3740.  
  3741. case begin_C:
  3742. case begin_RATFOR:
  3743. case begin_FORTRAN:
  3744. case begin_LITERAL
  3745.  
  3746.  
  3747.  
  3748. :
  3749. loc--;/* Position to language letter; fall through. */
  3750.  
  3751. case L_switch:
  3752. {
  3753. if(last_char!=0174)
  3754. {
  3755.  
  3756. {
  3757. ASCII l= *loc++;/* The basic language letter. */
  3758.  
  3759. switch(l)
  3760. {
  3761.  
  3762. case 0143:case 0103
  3763.  
  3764. :
  3765. Cpp= BOOLEAN(*loc==053);
  3766. break;
  3767.  
  3768.  
  3769. case 0162:case 0122
  3770.  
  3771. :
  3772.  
  3773. case 0156:case 0116
  3774.  
  3775. :
  3776. Fortran88= BOOLEAN(*loc==071);
  3777. break;
  3778.  
  3779.  
  3780. case 0166:case 0126
  3781.  
  3782.  
  3783.  
  3784. :
  3785.  
  3786. case 0170:case 0130
  3787.  
  3788. :
  3789. break;
  3790.  
  3791. default:
  3792.  
  3793. err0_print(ERR_C,OC("! Invalid language command `@L%c' ignored"),1,XCHR(l));
  3794. break;
  3795. }
  3796.  
  3797. opt_args(l);/* Set the language, and parse optional arguments after \
  3798.         language command. */
  3799. }
  3800.  
  3801.  
  3802.  
  3803. if(module_count==0)global_params= params;
  3804. set_output_file(language);
  3805. }
  3806. continue;
  3807. }
  3808.  
  3809. case begin_nuweb:
  3810. nuweb_mode1= nuweb_mode= !NUWEB_MODE;
  3811. if(module_count==0)global_params= params;
  3812. continue;
  3813.  
  3814. case control_text:
  3815. while((c= skip_ahead(ignore,NO))==0100);
  3816. /* only \.{@@} and \.{@>} are expected *//* Is |c| used?? */
  3817.  
  3818. if(*(loc-1)!=076)
  3819. err0_print(ERR_T,OC("Improper @ within control text"),0);
  3820.  
  3821. continue;
  3822.  
  3823. case compiler_directive:
  3824. case Compiler_Directive:
  3825. if(scanning_TeX)
  3826.  
  3827. err0_print(ERR_T,OC("Compiler directives are allowed only in code"),0);
  3828. loc= limit+1;
  3829. continue;
  3830.  
  3831. case invisible_cmnt:
  3832. loc= limit+1;
  3833. continue;
  3834.  
  3835. case module_name:
  3836. if(ncc==1&&last_control==formatt)
  3837. {
  3838. loc-= 2;
  3839. get_next();/* Scan module name to get it into table. */
  3840. continue;
  3841. }
  3842. break;
  3843.  
  3844. case big_line_break:/* \.{@\#} */
  3845. if(loc>=limit)continue;
  3846.  
  3847.  
  3848. {
  3849. boolean mcode;
  3850.  
  3851. *limit= ' ';/* Terminator for identifier search. */
  3852. id_first= loc;
  3853.  
  3854. while(isAlpha(*loc))loc++;/* Find end of identifier. */
  3855.  
  3856. if((mcode= is_mcmd(mcmds,id_first,loc))!=0)
  3857. {
  3858. while(loc<limit&&(*loc==040||*loc==tab_mark))
  3859. loc++;
  3860.  
  3861. return mcode;
  3862. }
  3863.  
  3864. loc= id_first;/* Failed to recognize preprocessor command. */
  3865. }
  3866.  
  3867.  
  3868. ;/* (See \.{typedefs.web}.) */
  3869. continue;
  3870.  
  3871. case USED_BY_NEITHER:
  3872.  
  3873. err0_print(ERR_T,OC("Invalid `@%c' ignored"),1,XCHR(*(loc-1)));
  3874. continue;
  3875. }
  3876.  
  3877. if(cc!=ignore||(*(loc-1)==076&&(ncc!=2)&&last_control!=formatt))
  3878. return cc;/* \.{@}~code or end of module name. */
  3879. }
  3880.  
  3881.  
  3882. }
  3883.  
  3884. DUMMY_RETURN(ignore);
  3885. }
  3886.  
  3887.  
  3888.  
  3889. eight_bits skip_bars(VOID)
  3890. {
  3891. PARAMS params0;
  3892. LANGUAGE language0= language;
  3893. eight_bits ret_val;
  3894.  
  3895. params0= params;/* Save state. */
  3896.  
  3897. loc++;/* Advance past the opening bar. */
  3898.  
  3899. WHILE()
  3900. {
  3901. if(loc>limit&&!get_line())
  3902. {
  3903.  
  3904. err0_print(ERR_W,OC("Reached end of file while skipping code text %s"),1,BTRANS);
  3905. ret_val= new_module;
  3906. goto done;
  3907. }
  3908.  
  3909. switch(next_control= get_next())
  3910. {
  3911. case begin_bp:
  3912. case insert_bp:
  3913. case begin_meta:
  3914. case end_meta:
  3915. case formatt:
  3916. case limbo_text:
  3917. case op_def:
  3918. case macro_def:
  3919. case definition:
  3920. case undefinition:
  3921. case WEB_definition:
  3922. case m_ifdef:
  3923. case m_ifndef:
  3924. case m_else:
  3925. case m_elif:
  3926. case m_endif:
  3927. case m_for:
  3928. case m_endfor:
  3929. case m_pragma:
  3930. case m_undef:
  3931. case begin_code:
  3932.  
  3933. err0_print(ERR_T,OC("Control code not allowed within |...|; \
  3934. inserted '|' in %s"),1,MTRANS);
  3935. loc-= 2;
  3936. ret_val= 0174;
  3937. goto done;
  3938.  
  3939. case new_module:
  3940.  
  3941. err0_print(ERR_T,OC("Module%s ended while skipping code text; \
  3942. inserted '|'"),1,MTRANS0);/* Falls through to next case! */
  3943.  
  3944. case 0174:
  3945. ret_val= next_control;
  3946. goto done;
  3947. }
  3948. }
  3949.  
  3950. done:
  3951. params= params0;
  3952. frz_params();
  3953. set_output_file(language0);
  3954.  
  3955. return ret_val;
  3956. }
  3957.  
  3958.  
  3959. #endif /* |Part == 1| */
  3960.  
  3961. #if(part == 0 || part == 2)
  3962.  
  3963.  
  3964. eight_bits out_char FCN((cur_char))
  3965. eight_bits cur_char C1("Token to control or be sent to the output.")
  3966. {
  3967. switch(cur_char)
  3968. {
  3969. case ignore:
  3970. if(R77_or_F&&started_vcmnt)C_putc(cur_char);
  3971. return 040;/* KLUDGE  to prevent |get_output| from being \
  3972. terminated prematurely. */
  3973.  
  3974. /* In nuweb mode, tab is mapped to bell on input, and back again here. */
  3975. case bell:
  3976. return out_dflt(tab_mark);
  3977. case 054:
  3978. out_dflt(cur_char);
  3979.  
  3980. {
  3981. #if FANCY_SPLIT
  3982. if(C_LIKE(language)&&out_state!=VERBATIM)
  3983. split_pos= pC_buffer;
  3984. #endif /* |FANCY_SPLIT| */
  3985. }
  3986.  
  3987.  
  3988. break;
  3989.  
  3990. case interior_semi:
  3991. if(!(Fortran88||in_string))cur_char= 073;
  3992. /* Fall through to regular semicolon. */
  3993.  
  3994. case 073:
  3995.  
  3996.  
  3997. if(send_rp)
  3998. {
  3999. C_putc(')');
  4000. send_rp= NO;/* Clear the flag. */
  4001. }
  4002.  
  4003. ;
  4004. return out_dflt(cur_char);
  4005.  
  4006. case cdir:
  4007. in_cdir= BOOLEAN(!in_cdir);
  4008. if(FORTRAN_LIKE(language))
  4009. {
  4010. in_string= NO;
  4011. flush_buffer();
  4012. in_string= YES;
  4013. }
  4014. break;
  4015.  
  4016. case 012:
  4017. if((copying_macros||!nuweb_mode)
  4018. &&(protect||out_state==VERBATIM))
  4019. {
  4020. /* Outer macros are absorbed with no explicit backslash at end of line. \
  4021. Furthermore, spaces are stripped from the start of the next line. \
  4022. Therefore, we will think of the end of line as a space.  Contrast this with \
  4023. explicit \.{\#define}'s continued with a backslash, which just abuts the \
  4024. last character of the line with the first character of the next one. */
  4025. if(copying_macros&&protect)
  4026. C_putc(' ');
  4027.  
  4028. out_str(t_style.protect_chars[lan_num(language)]);
  4029. /* Backslash at end of line. */
  4030. }
  4031.  
  4032.  
  4033. if(send_rp)
  4034. {
  4035. C_putc(')');
  4036. send_rp= NO;/* Clear the flag. */
  4037. }
  4038.  
  4039. ;
  4040. flush_buffer();
  4041. if(out_state!=VERBATIM)
  4042. out_state= MISCELLANEOUS;
  4043. break;
  4044.  
  4045.  
  4046. case end_format_stmt:
  4047. in_format= NO;
  4048. C_putc(';');
  4049. out_state= NUM_OR_ID;
  4050. break;
  4051.  
  4052. case begin_format_stmt:
  4053. in_format= YES;
  4054. OUT_OP(" format");
  4055. out_state= MISCELLANEOUS;
  4056. break;
  4057.  
  4058. case identifier:
  4059. cur_char= x_identifier(cur_char);
  4060. break;
  4061.  
  4062.  
  4063. ;
  4064.  
  4065.  
  4066. case module_number:
  4067. if(cur_val>0)prn_mod_num(OC("%c* %ld: *%c"),cur_val);/* Beginning. */
  4068. else if(cur_val<0)prn_mod_num(OC("%c* :%ld *%c"),cur_val);/* End. */
  4069. else
  4070. {/* Print out the line number; remember it for error messages. */
  4071. if(line_info)
  4072. {
  4073. nearest_line= BASE2*(*cur_byte++);
  4074. nearest_line+= *cur_byte++;/* Gets the line number. */
  4075.  
  4076. C_sprintf(OC("\n%cline %u \""),2,
  4077. language==TEX?'%':'#',nearest_line);
  4078.  
  4079. /* Get pointer to file name. */
  4080. cur_val= BASE2*(*cur_byte++);
  4081. cur_val+= *cur_byte++;
  4082.  
  4083.  
  4084. {
  4085. name_pointer np;
  4086.  
  4087.  
  4088. np= name_dir+cur_val;
  4089.  
  4090. if(truncate_ids)
  4091. out_trunc(np);
  4092. else
  4093. see_id(np->byte_start,(np+1)->byte_start);
  4094. }
  4095.  
  4096.  
  4097. C_sprintf(OC("\"\n"),0);
  4098. }
  4099.  
  4100. }
  4101.  
  4102. break;
  4103.  
  4104. ;
  4105.  
  4106.  
  4107. case plus_plus:
  4108. if(FORTRAN_LIKE(language))
  4109. {
  4110.  
  4111. {
  4112. outer_char HUGE*l;
  4113.  
  4114.  
  4115. /* The left-hand side has already been output. */
  4116. buffer_out('=');
  4117. out_state= MISCELLANEOUS;
  4118.  
  4119. /* Now output the |i|~in the above \
  4120. example again; however, in general, that could be subscripted etc. */
  4121. if(compound_assignments)
  4122. {
  4123. if(last_xpr_overflowed)
  4124. OVERFLW("last expression","lx");
  4125.  
  4126. for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
  4127. ;
  4128.  
  4129. if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
  4130.  
  4131. err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
  4132. operators correctly after simple IF; use an IF...THEN construction"),0);
  4133.  
  4134. while(l<plast_char)
  4135. buffer_out(*l++);
  4136. }
  4137. else FATAL("!! Operators ++, --, +=, -=, *=, and /= are not allowed; \
  4138. they were turned off by option \"-+\".","");
  4139. }
  4140.  
  4141. ;
  4142. buffer_out('+');buffer_out('1');
  4143. out_state= MISCELLANEOUS;
  4144. }
  4145. else
  4146. {
  4147. if(*(pC_buffer-1)=='+'&&!nuweb_mode)
  4148. C_putc(' ');/* Watch out for |x + ++y|. */
  4149. OUT_OP("++");
  4150. }
  4151.  
  4152.  
  4153. {
  4154. #if FANCY_SPLIT
  4155. if(C_LIKE(language)&&out_state!=VERBATIM)
  4156. split_pos= pC_buffer;
  4157. #endif /* |FANCY_SPLIT| */
  4158. }
  4159.  
  4160.  
  4161. break;
  4162.  
  4163. case minus_minus:
  4164. if(FORTRAN_LIKE(language))
  4165. {
  4166.  
  4167. {
  4168. outer_char HUGE*l;
  4169.  
  4170.  
  4171. /* The left-hand side has already been output. */
  4172. buffer_out('=');
  4173. out_state= MISCELLANEOUS;
  4174.  
  4175. /* Now output the |i|~in the above \
  4176. example again; however, in general, that could be subscripted etc. */
  4177. if(compound_assignments)
  4178. {
  4179. if(last_xpr_overflowed)
  4180. OVERFLW("last expression","lx");
  4181.  
  4182. for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
  4183. ;
  4184.  
  4185. if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
  4186.  
  4187. err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
  4188. operators correctly after simple IF; use an IF...THEN construction"),0);
  4189.  
  4190. while(l<plast_char)
  4191. buffer_out(*l++);
  4192. }
  4193. else FATAL("!! Operators ++, --, +=, -=, *=, and /= are not allowed; \
  4194. they were turned off by option \"-+\".","");
  4195. }
  4196.  
  4197. ;
  4198. buffer_out('-');buffer_out('1');
  4199. out_state= MISCELLANEOUS;
  4200. }
  4201. else
  4202. {
  4203. if(*(pC_buffer-1)=='-'&&!nuweb_mode)
  4204. C_putc(' ');/* Watch out for |x - --y|. */
  4205. OUT_OP("--");
  4206. }
  4207.  
  4208.  
  4209. {
  4210. #if FANCY_SPLIT
  4211. if(C_LIKE(language)&&out_state!=VERBATIM)
  4212. split_pos= pC_buffer;
  4213. #endif /* |FANCY_SPLIT| */
  4214. }
  4215.  
  4216.  
  4217. break;
  4218.  
  4219. case minus_gt:OUT_OP(FORTRAN_LIKE(language)?".EQV.":"->");break;
  4220.  
  4221. case gt_gt:
  4222.  
  4223. {
  4224. #if FANCY_SPLIT
  4225. if(C_LIKE(language)&&out_state!=VERBATIM)
  4226. split_pos= pC_buffer;
  4227. #endif /* |FANCY_SPLIT| */
  4228. }
  4229.  
  4230.  
  4231. OUT_OP(">>");break;
  4232.  
  4233. case eq_eq:
  4234.  
  4235. {
  4236. #if FANCY_SPLIT
  4237. if(C_LIKE(language)&&out_state!=VERBATIM)
  4238. split_pos= pC_buffer;
  4239. #endif /* |FANCY_SPLIT| */
  4240. }
  4241.  
  4242.  
  4243. OUT_OP(R77_or_F?F_OP(".EQ.","=="):"==");break;
  4244.  
  4245. case lt_lt:
  4246.  
  4247. {
  4248. #if FANCY_SPLIT
  4249. if(C_LIKE(language)&&out_state!=VERBATIM)
  4250. split_pos= pC_buffer;
  4251. #endif /* |FANCY_SPLIT| */
  4252. }
  4253.  
  4254.  
  4255. OUT_OP("<<");break;
  4256.  
  4257. case 076:
  4258. if(in_string)
  4259. out_dflt(cur_char);
  4260. else
  4261. OUT_OP(R77_or_F?F_OP(".GT.",">"):">");
  4262.  
  4263.  
  4264. {
  4265. #if FANCY_SPLIT
  4266. if(C_LIKE(language)&&out_state!=VERBATIM)
  4267. split_pos= pC_buffer;
  4268. #endif /* |FANCY_SPLIT| */
  4269. }
  4270.  
  4271.  
  4272. break;
  4273.  
  4274. case gt_eq:
  4275. OUT_OP(R77_or_F?F_OP(".GE.",">="):">=");
  4276.  
  4277. {
  4278. #if FANCY_SPLIT
  4279. if(C_LIKE(language)&&out_state!=VERBATIM)
  4280. split_pos= pC_buffer;
  4281. #endif /* |FANCY_SPLIT| */
  4282. }
  4283.  
  4284.  
  4285. break;
  4286.  
  4287. case 074:
  4288. if(in_string)
  4289. out_dflt(cur_char);
  4290. else
  4291. OUT_OP(R77_or_F?F_OP(".LT.","<"):"<");
  4292.  
  4293.  
  4294. {
  4295. #if FANCY_SPLIT
  4296. if(C_LIKE(language)&&out_state!=VERBATIM)
  4297. split_pos= pC_buffer;
  4298. #endif /* |FANCY_SPLIT| */
  4299. }
  4300.  
  4301.  
  4302. break;
  4303.  
  4304. case lt_eq:
  4305. OUT_OP(R77_or_F?F_OP(".LE.","<="):"<=");
  4306.  
  4307. {
  4308. #if FANCY_SPLIT
  4309. if(C_LIKE(language)&&out_state!=VERBATIM)
  4310. split_pos= pC_buffer;
  4311. #endif /* |FANCY_SPLIT| */
  4312. }
  4313.  
  4314.  
  4315. break;
  4316.  
  4317. case not_eq:
  4318. OUT_OP(R77_or_F?F_OP(".NE.","<>"):"!=");
  4319.  
  4320. {
  4321. #if FANCY_SPLIT
  4322. if(C_LIKE(language)&&out_state!=VERBATIM)
  4323. split_pos= pC_buffer;
  4324. #endif /* |FANCY_SPLIT| */
  4325. }
  4326.  
  4327.  
  4328. break;
  4329.  
  4330. case and_and:
  4331. OUT_OP(R77_or_F?".AND.":"&&");
  4332.  
  4333. {
  4334. #if FANCY_SPLIT
  4335. if(C_LIKE(language)&&out_state!=VERBATIM)
  4336. split_pos= pC_buffer;
  4337. #endif /* |FANCY_SPLIT| */
  4338. }
  4339.  
  4340.  
  4341. break;
  4342.  
  4343. case or_or:
  4344. if(language==TEX)meta_mode= YES;
  4345. else
  4346. {
  4347. OUT_OP(R77_or_F?".OR.":"||");
  4348.  
  4349. {
  4350. #if FANCY_SPLIT
  4351. if(C_LIKE(language)&&out_state!=VERBATIM)
  4352. split_pos= pC_buffer;
  4353. #endif /* |FANCY_SPLIT| */
  4354. }
  4355.  
  4356.  
  4357. }
  4358. break;
  4359.  
  4360. case star_star:
  4361. if(language==TEX)meta_mode= NO;
  4362. else OUT_OP(C_LIKE(language)?"^^":"**");
  4363. break;
  4364.  
  4365. case 041:
  4366.  
  4367. {
  4368. #if FANCY_SPLIT
  4369. if(C_LIKE(language)&&out_state!=VERBATIM)
  4370. split_pos= pC_buffer;
  4371. #endif /* |FANCY_SPLIT| */
  4372. }
  4373.  
  4374.  
  4375. if(in_string)
  4376. return out_dflt(cur_char);
  4377. else
  4378. OUT_OP(R77_or_F?".NOT.":"!");
  4379. break;
  4380.  
  4381. case slash_slash:OUT_OP("//");break;
  4382.  
  4383. case colon_colon:
  4384. if(in_string)
  4385. return out_dflt(cur_char);
  4386. else
  4387. OUT_OP("::");
  4388. break;
  4389.  
  4390. case ellipsis:
  4391. OUT_OP(FORTRAN_LIKE(language)?".NEQV.":"...");
  4392.  
  4393. {
  4394. #if FANCY_SPLIT
  4395. if(C_LIKE(language)&&out_state!=VERBATIM)
  4396. split_pos= pC_buffer;
  4397. #endif /* |FANCY_SPLIT| */
  4398. }
  4399.  
  4400.  
  4401. break;
  4402.  
  4403. case paste:OUT_OP("##");break;
  4404.  
  4405. case dot_const:
  4406. C_putc('.');
  4407. STRCPY(dot_op.name+1,dots[cur_val].symbol);
  4408. to_outer(dot_op.name+1);
  4409. OUT_OP(OC(dot_op.name+1));
  4410. C_putc('.');
  4411. break;
  4412.  
  4413. ;
  4414.  
  4415. case 053:
  4416. case 055:
  4417. case 052:
  4418. case 057:
  4419. /* These operators are handled in \Tangle\ as two adjacent tokens; we have \
  4420. to check for that, and we dare not be in |VERBATIM| mode. */
  4421. if(!FORTRAN_LIKE(language)||
  4422. cur_byte==cur_end||*cur_byte!=075||
  4423. out_state==VERBATIM||!xpn_Ratfor)
  4424. {
  4425. if(cur_char==052&&C_LIKE(language)&&out_state!=VERBATIM
  4426. &&*(pC_buffer-1)=='/'&&!nuweb_mode)
  4427. C_putc(' ');/* Watch out for |x/ *p|; not a comment. */
  4428.  
  4429. {
  4430. #if FANCY_SPLIT
  4431. if(C_LIKE(language)&&out_state!=VERBATIM)
  4432. split_pos= pC_buffer;
  4433. #endif /* |FANCY_SPLIT| */
  4434. }
  4435.  
  4436.  
  4437. return out_dflt(cur_char);
  4438. }
  4439.  
  4440. cur_byte++;/* Skip over the `\.='. */
  4441.  
  4442. {
  4443. outer_char HUGE*l;
  4444.  
  4445.  
  4446. /* The left-hand side has already been output. */
  4447. buffer_out('=');
  4448. out_state= MISCELLANEOUS;
  4449.  
  4450. /* Now output the |i|~in the above \
  4451. example again; however, in general, that could be subscripted etc. */
  4452. if(compound_assignments)
  4453. {
  4454. if(last_xpr_overflowed)
  4455. OVERFLW("last expression","lx");
  4456.  
  4457. for(l= last_char;isdigit(*l)||!isalpha(*l);l++)
  4458. ;
  4459.  
  4460. if(plast_char-l>=3&&STRNCMP(last_char,"if(",3)==0)
  4461.  
  4462. err0_print(ERR_T,OC("Sorry, can't expand compound assignment \
  4463. operators correctly after simple IF; use an IF...THEN construction"),0);
  4464.  
  4465. while(l<plast_char)
  4466. buffer_out(*l++);
  4467. }
  4468. else FATAL("!! Operators ++, --, +=, -=, *=, and /= are not allowed; \
  4469. they were turned off by option \"-+\".","");
  4470. }
  4471.  
  4472. ;
  4473. out_dflt(cur_char);
  4474. C_putc('(');
  4475. send_rp= YES;/* The enclosing right paren will be output when the \
  4476. next newline is encountered. */
  4477. break;
  4478.  
  4479. ;
  4480.  
  4481. case 075:
  4482. C_putc('=');
  4483. if(out_state!=VERBATIM)
  4484. {
  4485. if(C_LIKE(language)&&!nuweb_mode)
  4486. C_putc(' ');/* Space after equals. */
  4487.  
  4488. out_state= MISCELLANEOUS;
  4489. }
  4490.  
  4491. {
  4492. #if FANCY_SPLIT
  4493. if(C_LIKE(language)&&out_state!=VERBATIM)
  4494. split_pos= pC_buffer;
  4495. #endif /* |FANCY_SPLIT| */
  4496. }
  4497.  
  4498.  
  4499. break;
  4500.  
  4501. case join:out_state= UNBREAKABLE;break;
  4502.  
  4503. case constant:
  4504. if(out_state==VERBATIM)
  4505. out_state= in_format?MISCELLANEOUS:NUM_OR_ID;
  4506. /* End of constant. */
  4507. else
  4508. {/* Beginning of constant. */
  4509.  
  4510. {
  4511. #if FANCY_SPLIT
  4512. if(C_LIKE(language)&&out_state!=VERBATIM)
  4513. split_pos= pC_buffer;
  4514. #endif /* |FANCY_SPLIT| */
  4515. }
  4516.  
  4517.  
  4518.  
  4519. if(out_state==NUM_OR_ID&&!nuweb_mode)
  4520. C_putc(' ');
  4521.  
  4522. out_state= VERBATIM;
  4523. }
  4524.  
  4525. in_constant= BOOLEAN(!in_constant);
  4526. break;
  4527.  
  4528. case stringg:
  4529. if(in_string)
  4530. out_state= MISCELLANEOUS;/* End of string. */
  4531. else
  4532. {/* Begining of string. */
  4533.  
  4534. {
  4535. #if FANCY_SPLIT
  4536. if(C_LIKE(language)&&out_state!=VERBATIM)
  4537. split_pos= pC_buffer;
  4538. #endif /* |FANCY_SPLIT| */
  4539. }
  4540.  
  4541.  
  4542.  
  4543. if(out_state==NUM_OR_ID&&!nuweb_mode)
  4544. C_putc(' ');/* Strings after \
  4545. identifiers can happen in macro definitions. */
  4546.  
  4547. out_state= VERBATIM;
  4548. }
  4549.  
  4550. in_string= BOOLEAN(!in_string);
  4551. break;
  4552.  
  4553. case begin_meta:
  4554. /* If there are two |begin_meta|s in a row, the second one means to turn \
  4555. off the |xpn_Ratfor| flag, which among other things is used to control the \
  4556. spacing after the comment character in \Fortran\ output. */
  4557. pmeta= &t_style.meta[lan_num(language)];
  4558.  
  4559. switch(language)
  4560. {
  4561. outer_char*t;
  4562.  
  4563. case C:
  4564. case C_PLUS_PLUS:
  4565. case LITERAL:
  4566. case TEX:
  4567. if(meta_mode)break;
  4568.  
  4569. if(!nuweb_mode)
  4570. {
  4571. if(in_string&&!in_version)
  4572. OUT_STR(t= pmeta->msg.top);
  4573. else
  4574. OUT_OP(t= pmeta->hdr.top);
  4575.  
  4576. if(*t)OUT_STR("\n");/* Necessary???? */
  4577. }
  4578. meta_mode= YES;
  4579. break;
  4580.  
  4581. case RATFOR:
  4582. case RATFOR_90:
  4583. case FORTRAN:
  4584. case FORTRAN_90:
  4585. if(meta_mode)
  4586. xpn_Ratfor= NO;
  4587. C_putc(cur_char);
  4588. out_state= MISCELLANEOUS;
  4589. break;
  4590.  
  4591. default:
  4592. CONFUSION("out_char:begin_meta","Language not defined");
  4593. }
  4594. break;
  4595.  
  4596. case end_meta:
  4597. meta_mode= NO;
  4598.  
  4599. switch(language)
  4600. {
  4601. outer_char*t;
  4602.  
  4603. case C:
  4604. case C_PLUS_PLUS:
  4605. case LITERAL:
  4606. case TEX:
  4607. if(meta_mode)break;
  4608.  
  4609. if(!nuweb_mode)
  4610. {
  4611. if(in_string&&!in_version)
  4612. OUT_OP(t= pmeta->msg.bottom);
  4613. else
  4614. OUT_OP(t= pmeta->hdr.bottom);
  4615.  
  4616. if(*t)OUT_OP("\n");/* Necessary???? */
  4617. }
  4618. break;
  4619.  
  4620. case RATFOR:
  4621. case RATFOR_90:
  4622. case FORTRAN:
  4623. case FORTRAN_90:
  4624. xpn_Ratfor= YES;
  4625. C_putc(cur_char);
  4626. out_state= MISCELLANEOUS;
  4627. break;
  4628.  
  4629. default:
  4630. CONFUSION("out_char:end_meta","Language not defined");
  4631. }
  4632.  
  4633. break;
  4634.  
  4635. case 0173:
  4636. if(R77&&!in_string)
  4637.  
  4638. {
  4639. cp_fcn_body();/* See \.{rat77.web}. */
  4640. cur_char= 01;
  4641. }
  4642.  
  4643.  
  4644. else
  4645. {
  4646.  
  4647. {
  4648. #if FANCY_SPLIT
  4649. if(C_LIKE(language)&&out_state!=VERBATIM)
  4650. split_pos= pC_buffer;
  4651. #endif /* |FANCY_SPLIT| */
  4652. }
  4653.  
  4654.  
  4655. return out_dflt(cur_char);
  4656. }
  4657. break;
  4658.  
  4659. /* The following doesn't work right when there's no |program| statement. */
  4660. case 0175:
  4661. {
  4662. if(R77&&!in_string&&brace_level==0)
  4663.  
  4664. RAT_error(WARNING,OC("Spurious '}' ignored, \
  4665. or missing program, module, subroutine, or function statement"),0);
  4666. else
  4667. {
  4668. out_dflt(cur_char);
  4669.  
  4670. {
  4671. #if FANCY_SPLIT
  4672. if(C_LIKE(language)&&out_state!=VERBATIM)
  4673. split_pos= pC_buffer;
  4674. #endif /* |FANCY_SPLIT| */
  4675. }
  4676.  
  4677.  
  4678. }
  4679. }
  4680.  
  4681. break;
  4682.  
  4683. case 0133:
  4684. out_bracket(cur_char,050);
  4685. break;
  4686.  
  4687. case 0135:
  4688. out_bracket(cur_char,051);
  4689. break;
  4690.  
  4691.  
  4692. case 0140:
  4693. if(!(in_string||language==LITERAL))
  4694. {
  4695. mac_protected= BOOLEAN(!mac_protected);
  4696. break;
  4697. }
  4698. else
  4699. return out_dflt(cur_char);
  4700.  
  4701. case 046:
  4702. if(C_LIKE(language)&&out_state!=VERBATIM
  4703. &&*(pC_buffer-1)=='&'&&!nuweb_mode)
  4704. C_putc(' ');/* Handle the situation |x & &y|. */
  4705.  
  4706. {
  4707. #if FANCY_SPLIT
  4708. if(C_LIKE(language)&&out_state!=VERBATIM)
  4709. split_pos= pC_buffer;
  4710. #endif /* |FANCY_SPLIT| */
  4711. }
  4712.  
  4713.  
  4714. return out_dflt(cur_char);
  4715.  
  4716. case 0134:
  4717. if(R66)
  4718. cur_char= 044;/* Change octal constant to \Ratfor's \
  4719. argument token. This is kludgy and obsolete. */
  4720.  
  4721. default:
  4722. return out_dflt(cur_char);
  4723. }
  4724.  
  4725. return cur_char;
  4726. }
  4727.  
  4728.  
  4729.  
  4730. eight_bits out_bracket FCN((cur_char,new_char))
  4731. eight_bits cur_char C0("")
  4732. eight_bits new_char C1("")
  4733. {
  4734. if(out_state!=VERBATIM&&FORTRAN_LIKE(language)&&translate_brackets)
  4735. cur_char= new_char;
  4736. return out_dflt(cur_char);
  4737. }
  4738.  
  4739.  
  4740.  
  4741. eight_bits out_dflt FCN((c))
  4742. eight_bits c C1("")
  4743. {
  4744. C_putc(XCHR(c));
  4745.  
  4746. if(out_state!=VERBATIM)
  4747. out_state= MISCELLANEOUS;
  4748.  
  4749. return c;
  4750. }
  4751.  
  4752.  
  4753.  
  4754. LANGUAGE set_output_file FCN((language0))
  4755. LANGUAGE language0 C1("")
  4756. {
  4757. language= language0;/* Set the input language. */
  4758. out_file= params.OUT_FILE;/* Output of \.{TANGLE}. */
  4759. ini0_language();/* Set up parameters. */
  4760.  
  4761. return language;/* Return the input language. */
  4762. }
  4763.  
  4764.  
  4765.  
  4766. LANGUAGE opn_output_file FCN((language0))
  4767. LANGUAGE language0 C1("")
  4768. {
  4769. set_output_file(language0);
  4770. flush_buffer();
  4771. open_out(OC(""),LOCAL_SCOPE);
  4772.  
  4773. return language;
  4774. }
  4775.  
  4776.  
  4777.  
  4778. boolean skip_comment(VOID)
  4779. {
  4780. ASCII c;/* current character */
  4781. PARSING_MODE outer_mode;
  4782.  
  4783. outer_mode= parsing_mode;
  4784. parsing_mode= OUTER;
  4785.  
  4786. if(comment_continues)loc--;/* We've already scanned over white space, so \
  4787.   |loc| is presently one position beyond the first non-blank character on the \
  4788.   continuation line. */
  4789. else if(*(loc-1)==057)loc++;/* If we're starting a comment, |loc|~is \
  4790.   positioned on the star; move past that. */
  4791.  
  4792. WHILE()
  4793. {
  4794. if(loc>limit)
  4795. if(!long_comment)
  4796. {
  4797. comment_continues= NO;
  4798. break;
  4799. }
  4800.  
  4801.  
  4802. else if(get_line())
  4803. {
  4804. comment_continues= YES;
  4805. break;
  4806. }
  4807. else
  4808. {
  4809.  
  4810. err0_print(ERR_T,OC("Input ended in middle of comment %s"),1,BTRANS);
  4811.  
  4812. comment_continues= NO;
  4813. break;/* We |break| out and return so |get_next| can \
  4814. return a newline. */
  4815. }
  4816.  
  4817. c= *(loc++);
  4818.  
  4819. if(c==052&&*loc==057)
  4820. {
  4821. loc++;
  4822.  
  4823. {
  4824. comment_continues= NO;
  4825. break;
  4826. }
  4827.  
  4828.  
  4829. }
  4830.  
  4831. if(c==0100)
  4832. {
  4833. if(ccode[*loc]==new_module)/* `\.{@\ }' or `\.{@*}' */
  4834. {
  4835.  
  4836. err0_print(ERR_T,OC("Section name ended in middle of comment %s"),1,BTRANS);
  4837. loc--;
  4838.  
  4839.  
  4840. {
  4841. comment_continues= NO;
  4842. break;
  4843. }
  4844.  
  4845.  
  4846. }
  4847. else loc++;
  4848. }
  4849. }
  4850.  
  4851. parsing_mode= outer_mode;
  4852. return comment_continues;
  4853. }
  4854.  
  4855.  
  4856.  
  4857. eight_bits get_next(VOID)/* produces the next input token */
  4858. {
  4859. GOTO_CODE pcode;/* Return code from the parse routines. */
  4860.  
  4861. strt_point_cmnt= suppress_newline= NO;
  4862.  
  4863. WHILE()
  4864. {
  4865.  
  4866.  
  4867. if(preprocessing&&at_beginning)
  4868. {
  4869. at_beginning= NO;
  4870.  
  4871. /* Preprocessor directives can have white space between the '\.\#' and the \
  4872. name. */
  4873. for(;loc<limit;loc++)
  4874. if(!(*loc==040||*loc==tab_mark))break;
  4875.  
  4876. *(loc-1)= 043;/* Now we're positioned on an identifier beginning \
  4877. with |'#'|, with no intervening blanks. */
  4878. return(eight_bits)prs_regular_code(GOTO_GET_IDENTIFIER);
  4879. }
  4880.  
  4881. ;
  4882.  
  4883.  
  4884. if(*loc==cont_char&&loc==limit-1&&(preprocessing||free_Fortran))
  4885. {
  4886. loc+= 2;/* Force it to read another line the next time through. */
  4887. return(eight_bits)CHOICE(free_Fortran,046,cont_char);/* We \
  4888. leave the format of the input file alone. Since we're using free-form \
  4889. syntax, the compiler will continue the line correctly. */
  4890. }
  4891.  
  4892. ;
  4893.  
  4894. if(loc>limit)
  4895. if(from_buffer)
  4896. {
  4897. undivert();/* Stop reading from buffer; go back to \
  4898.                 reading from files. */
  4899. if(stop_the_scan)
  4900. return WEB_definition;
  4901. continue;
  4902. }
  4903. else
  4904. {/* Reading from file. */
  4905. if(preprocessing&&*(limit-1)!=cont_char)
  4906. {
  4907. preprocessing= NO;
  4908. if(in_cdir)
  4909. {
  4910. id_first= id_loc= mod_text+1;
  4911. *id_loc++= cdir;
  4912. *id_loc++= '\0';
  4913. in_cdir= NO;
  4914. return stringg;
  4915. }
  4916. }
  4917. if(stop_the_scan)
  4918. return WEB_definition;
  4919. else if(!get_line())
  4920. return new_module;
  4921.  
  4922. if(eat_blank_lines)
  4923. {
  4924. eat_blank_lines= NO;
  4925.  
  4926. while(loc>=limit)
  4927. if(!get_line())
  4928. return new_module;
  4929. }
  4930.  
  4931. at_beginning= BOOLEAN(!preprocessing);
  4932.  
  4933. if(prn_where)
  4934. {
  4935. prn_where= NO;
  4936.  
  4937. if(!scanning_defn)
  4938. ins_ln_no()
  4939.  
  4940. ;
  4941. }
  4942. else if(!suppress_newline&&
  4943. (!R77_or_F||limit==cur_buffer||free_Fortran))
  4944. return 012;
  4945. }
  4946. else at_beginning= BOOLEAN(!preprocessing&&(loc==cur_buffer));
  4947.  
  4948. if(preprocessing)
  4949.  
  4950. {
  4951. boolean found_white_space= NO;
  4952.  
  4953. do
  4954. {
  4955. if((c= *loc++)!=040||c!=tab_mark)
  4956. break;
  4957.  
  4958. found_white_space= YES;
  4959. }
  4960. while(loc<limit);
  4961.  
  4962.  
  4963. if(found_white_space)
  4964. return 040;
  4965. }
  4966.  
  4967.  
  4968. else
  4969.  
  4970. {
  4971. if(language==TEX)
  4972. c= *loc++;
  4973. else
  4974. {
  4975. ASCII HUGE*loc0= loc;/* Remember starting point for nuweb mode. */
  4976.  
  4977. do
  4978. {/* Skip beginning white space. */
  4979. c= *loc++;
  4980. }
  4981. while(loc<=limit&&(c==040||c==tab_mark));
  4982.  
  4983. if(nuweb_mode)
  4984. {
  4985. if(!(c==0100&&*loc==043))
  4986. {/* Go back to beginning. */
  4987. loc= loc0;
  4988. c= *loc++;
  4989. }
  4990. }
  4991. }
  4992. }
  4993.  
  4994.  
  4995.  
  4996. strt_cmnt= NO;
  4997.  
  4998. switch(language)
  4999. {
  5000. case TEX:
  5001. if(!scanning_defn)
  5002. {
  5003. if((pcode= prs_TeX_code())==MORE_PARSE)
  5004. break;
  5005. else if(pcode<0)
  5006. CONFUSION("prs_TEX_code","Negative pcode");
  5007. else
  5008. RETURN(pcode);
  5009. }
  5010.  
  5011. default:
  5012. if((pcode= prs_regular_code(MORE_PARSE))==MORE_PARSE)
  5013. break;
  5014. else if((int)pcode<0)
  5015. CONFUSION("prs_regular_code","Negative pcode");
  5016. else
  5017. RETURN(pcode);
  5018. }
  5019. }
  5020.  
  5021. DUMMY_RETURN(ignore);
  5022. }
  5023.  
  5024.  
  5025. GOTO_CODE prs_TeX_code(VOID)
  5026. {
  5027. GOTO_CODE icode;/* Return code from |get_control_code|. */
  5028.  
  5029. if(loc>limit)
  5030. return MORE_PARSE;
  5031.  
  5032. if(TeX[c]==TeX_comment)
  5033.  
  5034. {
  5035. long_comment= NO;
  5036.  
  5037. if((all_cmnts_verbatim||(keep_trailing_comments&&!at_beginning))
  5038. &&!(scanning_defn&&is_WEB_macro))
  5039. {
  5040. strt_cmnt= YES;
  5041. }
  5042. else
  5043. {
  5044. loc= limit+1;/* Skip rest of line. */
  5045. return MORE_PARSE;
  5046. }
  5047. }
  5048.  
  5049.  
  5050.  
  5051. if(c==0100)
  5052. {
  5053. icode= get_control_code();
  5054.  
  5055. if(icode==MORE_PARSE)
  5056. return icode;
  5057.  
  5058. if((int)(icode)<0)
  5059. return prs_regular_code(icode);
  5060. else
  5061. return(eight_bits)icode;
  5062. }
  5063. else
  5064.  
  5065. {
  5066. loc--;
  5067. id_first= id_loc= mod_text+1;
  5068.  
  5069. if(strt_cmnt)
  5070. *id_loc++= begin_Xmeta;
  5071.  
  5072. while(loc<limit)
  5073. {
  5074. if(*loc==0100)
  5075. {
  5076. if(*(loc+1)==0100)
  5077. *id_loc++= *loc++;
  5078. }
  5079. else if(!strt_cmnt&&TeX[*loc]==TeX_comment&&*(loc-1)!=0134)
  5080. break;
  5081.  
  5082. *id_loc++= *loc++;
  5083. }
  5084.  
  5085. if(strt_cmnt)
  5086. *id_loc++= end_Xmeta;
  5087.  
  5088. return stringg;
  5089. }
  5090.  
  5091.  
  5092. }
  5093.  
  5094.  
  5095. GOTO_CODE prs_regular_code FCN((iswitch))
  5096. GOTO_CODE iswitch C1("")
  5097. {
  5098. GOTO_CODE icode;/* Return code from |get_control_code|. */
  5099.  
  5100. switch(iswitch)
  5101. {
  5102. case MORE_PARSE:break;
  5103.  
  5104. case GOTO_MISTAKE:goto mistake;
  5105. case GOTO_GET_IDENTIFIER:goto get_identifier;
  5106. case GOTO_GET_A_STRING:goto get_a_string;
  5107. case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
  5108. }
  5109.  
  5110. if(language!=LITERAL)
  5111.  
  5112. {
  5113. switch(c)
  5114. {
  5115. case(ASCII)begin_comment0:
  5116. long_comment= strt_cmnt= YES;
  5117. break;
  5118.  
  5119. case(ASCII)begin_comment1:
  5120. strt_cmnt= strt_point_cmnt= YES;
  5121. long_comment= NO;
  5122. break;
  5123.  
  5124. case 057:
  5125. if(*loc==052)
  5126. long_comment= strt_cmnt= YES;
  5127. else if(*loc==057&&(C_LIKE(language)||(Cpp_comments&&
  5128. !in_format&&FORTRAN_LIKE(language))))
  5129. {/* Short comments are recognized in both~C and \Cpp. */
  5130. long_comment= NO;
  5131. strt_cmnt= YES;
  5132. }
  5133. break;
  5134.  
  5135. case 041:
  5136. /* \Fortran\ will handle the commenting style ``\.{! Comment}'' if \
  5137. |point_comments| is on, or ``\.{!! Comment}'' always. */
  5138. if((*loc==041||point_comments)&&FORTRAN_LIKE(language))
  5139. {
  5140. *(loc-1)= (ASCII)begin_comment1;/* This marker is \
  5141. necessary so the verbatim comments don't get confused with \.{@!}. */
  5142. strt_cmnt= strt_point_cmnt= YES;
  5143. long_comment= NO;
  5144. }
  5145. break;
  5146. }
  5147.  
  5148. if(strt_cmnt&&all_cmnts_verbatim&&!(scanning_defn&&is_WEB_macro))
  5149. {
  5150. loc--;/* Position on the '\./'. */
  5151.  
  5152.  
  5153. switch(icode= get_control_code())
  5154. {
  5155. case GOTO_MISTAKE:goto mistake;
  5156. case GOTO_GET_A_STRING:goto get_a_string;
  5157. case GOTO_GET_IDENTIFIER:goto get_identifier;
  5158. case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
  5159.  
  5160. case MORE_PARSE:
  5161. default:return icode;
  5162. }
  5163.  
  5164.  
  5165. }
  5166. else if(strt_cmnt||comment_continues)
  5167. {
  5168. skip_a_comment:
  5169. skip_comment();/* scan to end of comment or newline */
  5170.  
  5171. if((comment_continues||!long_comment)&&
  5172. !(scanning_defn&&is_WEB_macro))return 012;
  5173. else return MORE_PARSE;
  5174. }
  5175.  
  5176. if(loc==limit&&c==cont_char&&
  5177. (preprocessing||(auto_semi&&R77)))return MORE_PARSE;
  5178. }
  5179.  
  5180.  
  5181.  
  5182. /* --- ELLIPSIS --- */
  5183. if(c==056&&*loc==056&&*(loc+1)==056)
  5184. {
  5185. ++loc;
  5186. compress(ellipsis);
  5187. }
  5188.  
  5189. /* --- DOT CONSTANT: `\.{.FALSE.}' --- */
  5190. else if(FORTRAN_LIKE(language)&&dot_constants&&
  5191. (c==wt_style.dot_delimiter.begin)&&!isDigit(*loc))
  5192.  
  5193. {
  5194. ASCII HUGE*p0;
  5195. int n;
  5196. eight_bits c;
  5197. ASCII dot_end= wt_style.dot_delimiter.end;
  5198.  
  5199.  
  5200. /* At this point, |loc| is positioned to the first position after the dot. */
  5201. for(p0= loc,n= 0;n<MAX_DOT_LENGTH;n++,loc++)
  5202. if(*loc==dot_end||!isAlpha(*loc))break;/* Found end of dot \
  5203. constant. */
  5204.  
  5205. if(*loc!=dot_end)/* Didn't find end. */
  5206. {
  5207. loc= p0;/* Reset position back to beginning. */
  5208. goto mistake;
  5209. }
  5210.  
  5211. c= dot_code(dots,uppercase(p0,n),loc++,dot_const);
  5212.  
  5213. if(c)return c;
  5214. else
  5215. {
  5216. loc= p0;
  5217. goto mistake;
  5218. }
  5219.  
  5220. }
  5221.  
  5222.  
  5223.  
  5224. /* --- CONSTANT: `\.{123}', `\.{.1}', or `\.{\\135}' --- */
  5225. else if(isDigit(c)||c==0134||c==056)
  5226.  
  5227. {
  5228. boolean decimal_point;
  5229.  
  5230.  
  5231. if(loc==limit&&c==cont_char)
  5232. {
  5233. if(preprocessing)loc++;
  5234. return(eight_bits)c;
  5235. }
  5236.  
  5237. starts_with_0= hex_constant= bin_constant= floating_constant= NO;
  5238.  
  5239. id_first= loc-1;
  5240.  
  5241. if(*id_first==056&&!isDigit(*loc))goto mistake;/* not a constant */
  5242.  
  5243. if(*id_first==0134)
  5244. {
  5245. if(*loc==057)goto mistake;
  5246. while(isOdigit(*loc))loc++;/* octal constant */
  5247. goto found;
  5248. }
  5249. else
  5250. {
  5251. starts_with_0= BOOLEAN(*id_first==060);
  5252. if(starts_with_0)
  5253. {
  5254. hex_constant= BOOLEAN(*loc==0170||*loc==0130);
  5255.  
  5256. if(hex_constant)
  5257. {/* hex constant---e.g, \.{0xA1} */
  5258. loc++;while(isXdigit(*loc))loc++;goto found;
  5259. }
  5260. else if((bin_constant= BOOLEAN(*loc==0142||*loc==0102))!=0)
  5261. {/* Binary constant---e.g., |0b101|. */
  5262. loc++;
  5263. while(isBdigit(*loc))loc++;
  5264. goto found;
  5265. }
  5266. }
  5267.  
  5268. while(isDigit(*loc))loc++;/* Skip over digits. */
  5269. decimal_point= BOOLEAN(*loc==056);
  5270. if(decimal_point)loc++;/* Check if decimal point. */
  5271. while(isDigit(*loc))loc++;/* Skip over digits after decimal point. */
  5272.  
  5273. if(FORTRAN_LIKE(language))
  5274. if(*(loc-1)==056)
  5275. {
  5276. /* If the constant doesn't end with a digit, \
  5277. make sure the dot isn't the start of a dot constant. */
  5278. if(is_dot())
  5279. {
  5280. loc--;
  5281. goto found;
  5282. }
  5283. }
  5284. else if(*loc==0150||*loc==0110)
  5285.  
  5286. {
  5287. int l,n;
  5288.  
  5289.  
  5290. *loc++= '\0';/* Terminate string after the length \
  5291.     (temporarily overwriting the 'H'); position to actual constant. */
  5292. n= ATOI(id_first);/* Length of constant. */
  5293. *(loc-1)= 0110;/* Reconstruct the 'H'. */
  5294.  
  5295. for(l= 0;l<n;++l)++loc;/* Skip over the constant. */
  5296.  
  5297. goto found;
  5298. }
  5299.  
  5300.  
  5301.  
  5302. floating_constant= BOOLEAN(*loc==0145||*loc==0105||
  5303. (FORTRAN_LIKE(language)
  5304. &&(*loc==0144||*loc==0104||*loc==0161||*loc==0121)));
  5305.  
  5306. if(floating_constant)
  5307. {/* float constant---e.g., \.{1.0e-5}  */
  5308. if(*++loc==053||*loc==055)loc++;
  5309. while(isDigit(*loc))loc++;
  5310. }
  5311.  
  5312. floating_constant|= decimal_point;
  5313. }
  5314.  
  5315. found:
  5316. if(C_LIKE(language))
  5317. {/* Check for |unsigned|, |long|, or |float| suffix. */
  5318. boolean its_long= NO,its_unsigned= NO,its_constant= NO;
  5319.  
  5320. switch(*loc)
  5321. {
  5322. case 0154:
  5323. case 0114:
  5324. its_constant= its_long= YES;
  5325. break;
  5326.  
  5327. case 0165:
  5328. case 0125:
  5329. its_constant= its_unsigned= YES;
  5330. break;
  5331.  
  5332. case 0146:
  5333. case 0106:
  5334. its_constant= YES;
  5335. break;
  5336. }
  5337.  
  5338. if(its_constant)
  5339. {/* |long|, |float|, or |unsigned| \
  5340. constant---e.g., \.{123L} */
  5341. loc++;/* Skip over suffix. */
  5342.  
  5343. /* Might be a second suffix. */
  5344. if(its_long&&(*loc==0165||*loc==0125))
  5345. loc++;/* |50LU| */
  5346. else if(its_unsigned&&(*loc==0154||*loc==0114))
  5347. loc++;/* |50UL| */
  5348. }
  5349. }
  5350. else if(Fortran88)
  5351. {
  5352. if(*loc==0137)
  5353. while(is_kind(*loc))loc++;
  5354. }
  5355.  
  5356.  
  5357.  
  5358. id_loc= loc;
  5359. return constant;
  5360. }
  5361.  
  5362.  
  5363.  
  5364. /* --- IDENTIFIER --- */
  5365. else if(is_identifier(c))
  5366.  
  5367. {
  5368. IN_COMMON ASCII HUGE*pformat,HUGE*pdata;
  5369.  
  5370. get_identifier:
  5371.  
  5372. {
  5373. id_first= --loc;
  5374.  
  5375. /* Scan over subsequent elements of an identifier. */
  5376. for(++loc;isAlpha(*loc)||isDigit(*loc)
  5377. ||*loc==0137||*loc==044||(in_format&&*loc==056);loc++)
  5378. ;
  5379.  
  5380. id_loc= loc;/* End plus one of the identifier.*/
  5381. }
  5382.  
  5383.  
  5384.  
  5385.  
  5386. if(FORTRAN_LIKE(language))
  5387. {
  5388. if(web_strcmp(pformat,pformat+6,id_first,id_loc)==EQUAL)
  5389. {/* Raise special flag to say we're inside a |@r format| \
  5390. statement. */
  5391. in_format= YES;
  5392. return begin_format_stmt;
  5393. }
  5394. else if(program==weave)
  5395. {
  5396. if(web_strcmp(pdata,pdata+4,id_first,id_loc)==EQUAL)
  5397. {/* Inside a |@r data| statement. */
  5398. in_data= YES;
  5399. return identifier;
  5400. }
  5401. else if(at_beginning&&*loc==':'&&
  5402. !is_in(non_labels,id_first,id_loc))
  5403. return stmt_label;
  5404. }
  5405. }
  5406.  
  5407. if(is_include_like())sharp_include_line= YES;
  5408. return identifier;
  5409. }
  5410.  
  5411.  
  5412.  
  5413.  
  5414. /* --- STRING --- */
  5415. else if((c==047||c==042)
  5416. ||(is_RATFOR_(language)&&sharp_include_line==YES&&c==050))
  5417. {
  5418. if(language==LITERAL)
  5419. return c;
  5420. else
  5421.  
  5422. get_a_string:
  5423. {
  5424. ASCII delim= c;/* what started the string */
  5425. ASCII right_delim= c;
  5426. int level;
  5427. boolean equal_delims;
  5428.  
  5429. id_first= mod_text+1;/* Position of delimiter. */
  5430. id_loc= mod_text;*++id_loc= delim;
  5431.  
  5432. if(delim==050)
  5433. {
  5434. right_delim= 051;/* For m4 |@r include|. */
  5435. sharp_include_line= NO;
  5436. }
  5437.  
  5438. level= 1;
  5439.  
  5440. equal_delims= BOOLEAN(right_delim==delim);
  5441.  
  5442. WHILE()
  5443. {
  5444. if(loc>=limit)
  5445. {
  5446. if((equal_delims||chk_ifelse)&&*(limit-1)!=cont_char)
  5447. /* Continuation after next line. */
  5448. {
  5449.  
  5450. err0_print(ERR_T,OC("String %s with '%s%c' didn't end"),3,BTRANS,delim==047?"\\":"",XCHR(delim));
  5451. loc= limit;break;
  5452.  
  5453. }
  5454.  
  5455. if(!get_line())
  5456. {
  5457.  
  5458. err0_print(ERR_T,OC("Input ended in middle of string \
  5459. %s with '%s%c'"),3,BTRANS,delim==047?"\\":"",XCHR(delim));
  5460. loc= cur_buffer;
  5461. break;
  5462.  
  5463. }
  5464. else
  5465. {
  5466. if(C_LIKE(language)&&++id_loc<=mod_end)*id_loc= 012;
  5467. /* More string to come; will print as \.{"\\\\\\n"} */
  5468.  
  5469. /* Now the continuation of the string is in the buffer.  If appropriate, \
  5470. skip over beginning white space and backslash. */
  5471. if(bslash_continued_strings)
  5472. {
  5473. for(;loc<limit;loc++)
  5474. if(*loc!=040&&*loc!=tab_mark)break;
  5475.  
  5476. if(*loc==cont_char)loc++;/* Move past the backslash. */
  5477. else
  5478. err0_print(ERR_T,OC("Inserted '%c' at beginning of continued \
  5479. string"),1,XCHR(cont_char));
  5480. }
  5481. }
  5482. }
  5483.  
  5484. if(!equal_delims)
  5485.  
  5486. if(*loc==057&&*(loc+1)==052)
  5487. for(loc+= 2;;loc++)
  5488. {
  5489. if(loc>=limit)
  5490. if(!get_line())
  5491. {
  5492.  
  5493. err0_print(ERR_T,OC("Input ended in middle of embedded comment %s"),1,BTRANS);
  5494. loc= cur_buffer;
  5495. goto found_string;
  5496. }
  5497.  
  5498. if(*loc==052&&*(loc+1)==057)
  5499. {
  5500. loc+= 2;
  5501. break;
  5502. }
  5503. }
  5504.  
  5505. ;
  5506.  
  5507. if((c= *loc++)==delim)
  5508. {
  5509. level++;
  5510.  
  5511. if(++id_loc<=mod_end)*id_loc= c;
  5512.  
  5513. if(!equal_delims)continue;
  5514.  
  5515. if(*loc==delim&&!(C_LIKE(language)||
  5516. (is_RATFOR_(language)&&Ratfor77)))
  5517. ++loc;/* Copy over repeated delimiter. */
  5518. else break;/* Found end of string. */
  5519. }
  5520.  
  5521. if(c==right_delim)
  5522. if(--level==0)
  5523. {
  5524. if(++id_loc<=mod_end)*id_loc= c;
  5525. break;/* Found end of string for unequal delims. */
  5526. }
  5527.  
  5528. /* Double the quote. */
  5529. if(R77&&c==047)
  5530. if(++id_loc<=mod_end)*id_loc= c;
  5531.  
  5532. if(c==cont_char)
  5533. {
  5534. if(loc>=limit&&(!is_FORTRAN_(language)||free_form_input))
  5535. continue;/* Continuation of string; throw away the \
  5536. continuation character. */
  5537.  
  5538. if(!is_FORTRAN_(language))
  5539. {
  5540. c= *loc++;/* Character after backslash. */
  5541.  
  5542. if(R77)
  5543. switch(c)
  5544. {
  5545. #if(0)
  5546. #define n c
  5547.  
  5548. case 060:n= '\0';break;
  5549. case 0134:n= 0134;break;
  5550. case 047:n= 047;break;
  5551. case 042:n= 042;break;
  5552. case 077:n= 077;break;/* Microsoft doesn't like. */
  5553. case 0141:n= 07;break;/* SGI didn't understand. */
  5554. case 0142:n= 010;break;
  5555. case 0146:n= 014;break;
  5556. case 0156:n= 012;break;
  5557. case 0162:n= 015;break;
  5558. case 0164:n= 011;break;
  5559. case 0166:n= 013;break;
  5560.  
  5561.  
  5562. #undef n
  5563. #endif
  5564. /* Double the quote for the direct-to-Fortran output. */
  5565. case 047:
  5566. if(++id_loc<=mod_end)*id_loc= c;
  5567. break;
  5568. }
  5569. else{if(++id_loc<=mod_end)*id_loc= 0134;}
  5570. }
  5571. }
  5572.  
  5573. if(++id_loc<=mod_end)*id_loc= c;/* Store the character. */
  5574. }
  5575.  
  5576. found_string:
  5577. if(id_loc>=mod_end){
  5578. SET_COLOR(error);
  5579. printf("\n! String too long: ");
  5580.  
  5581. ASCII_write(mod_text+1,25);
  5582. printf("...");mark_error;
  5583. }
  5584.  
  5585. id_loc++;
  5586. return stringg;
  5587. }
  5588.  
  5589.  
  5590. }
  5591.  
  5592. /* --- CONTROL CODE --- */
  5593. else if(c==0100)
  5594.  
  5595. switch(icode= get_control_code())
  5596. {
  5597. case GOTO_MISTAKE:goto mistake;
  5598. case GOTO_GET_A_STRING:goto get_a_string;
  5599. case GOTO_GET_IDENTIFIER:goto get_identifier;
  5600. case GOTO_SKIP_A_COMMENT:goto skip_a_comment;
  5601.  
  5602. case MORE_PARSE:
  5603. default:return icode;
  5604. }
  5605.  
  5606.  
  5607.  
  5608. /* --- WHITE SPACE --- */
  5609. else if(c==040||c==tab_mark)
  5610. if(nuweb_mode)
  5611. return(c==tab_mark?bell:c);
  5612. else
  5613. {
  5614. if(!preprocessing||loc>limit)return MORE_PARSE;
  5615. /* we don't want a blank after a final backslash */
  5616. else return 040;
  5617. /* Ignore spaces and tabs, unless preprocessing. */
  5618. }
  5619.  
  5620. /* --- C PREPROCESSOR COMMAND --- */
  5621. else if(c==043&&at_beginning&&C_LIKE(language))
  5622. {
  5623. preprocessing= YES;
  5624. return MORE_PARSE;
  5625. }
  5626.  
  5627. /* --- END of |@r format| STATEMENT --- */
  5628. else if(in_format&&c==073)/* End a |@r format| statement. */
  5629. {
  5630. in_format= NO;
  5631. return end_format_stmt;
  5632. }
  5633.  
  5634. /* --- TWO-SYMBOL OPERATOR --- */
  5635. mistake:
  5636. if(language!=LITERAL)
  5637.  
  5638. switch(c)
  5639. {
  5640. case 057:
  5641. case 0134:
  5642. if(FORTRAN_LIKE(language)&&!in_format&&(*loc==057))
  5643. {
  5644. if(Cpp_comments&&c==057)break;/* In this case, the \
  5645. slashes are the \Cpp-style comments.  We'll always allow \.{\\/} as a \
  5646. synonym for concatenation. */
  5647.  
  5648. compress(slash_slash);/* \Fortran's concatenation \
  5649. operator. Multiple slashes in |format| statements are just left alone. */
  5650. }
  5651. break;
  5652. case 053:if(*loc==053)compress(plus_plus);break;
  5653.  
  5654. case 055:if(*loc==055){compress(minus_minus);}
  5655. else if(*loc==076)compress(minus_gt);break;
  5656.  
  5657. case 075:if(*loc==075)compress(eq_eq);break;
  5658.  
  5659. case 076:if(*loc==075){compress(gt_eq);}
  5660. else if(*loc==076){compress(gt_gt);}
  5661. break;
  5662.  
  5663. case 074:if(*loc==075){compress(lt_eq);}
  5664. else if(*loc==074){compress(lt_lt);}
  5665. else if(*loc==076){compress(not_eq);}/* \FORTRAN-88 */
  5666. break;
  5667.  
  5668. case 046:if(*loc==046)compress(and_and);break;
  5669.  
  5670. case 0174:if(*loc==0174)compress(or_or);break;
  5671.  
  5672. case 041:if(*loc==075){compress(not_eq);}break;
  5673.  
  5674. case 052:
  5675. if(FORTRAN_LIKE(language)&&(*loc==052))
  5676. {compress(star_star);}/* Exponentiation. */
  5677. break;
  5678.  
  5679. case 0136:
  5680. if(*loc==0136){compress(star_star);}
  5681. else if(FORTRAN_LIKE(language)&&(loc<limit))return star_star;
  5682. break;
  5683.  
  5684. case 043:
  5685. if(*loc==043){compress(paste);}
  5686. else if(*loc==074)
  5687. {
  5688. loc++;
  5689. mac_mod_name= YES;
  5690.  
  5691. {
  5692. ASCII HUGE*k;/* pointer into |mod_text| */
  5693. static ASCII ell[]= "\56\56\56";
  5694.  
  5695.  
  5696.  
  5697. {
  5698. int mlevel= 1;/* For nested module names. */
  5699.  
  5700. k= mod_text;
  5701.  
  5702. WHILE()
  5703. {
  5704. if(loc>limit&&!get_line())
  5705. {
  5706.  
  5707. err0_print(ERR_T,OC("Input ended in section name %s"),1,BTRANS);
  5708.  
  5709. loc= cur_buffer+1;break;
  5710. }
  5711.  
  5712. c= *loc;
  5713.  
  5714.  
  5715. if(c==0100)
  5716. {
  5717. c= *(loc+1);
  5718.  
  5719. if(c==076)
  5720. {
  5721. if(--mlevel==0)
  5722. {
  5723. loc+= 2;break;/* Successful; position after \.{@>}. */
  5724. }
  5725. }
  5726. else if(c==074)mlevel++;
  5727.  
  5728. if(ccode[c]==new_module)
  5729. {
  5730.  
  5731. err0_print(ERR_T,OC("Section name %s didn't end"),1,BTRANS);
  5732.  
  5733. break;
  5734. }
  5735.  
  5736. *(++k)= 0100;loc++;/* Now |c==*loc| again. */
  5737. }
  5738.  
  5739. ;
  5740. loc++;
  5741.  
  5742. if(k<mod_end)k++;
  5743.  
  5744. switch(c)
  5745. {
  5746. case 040:
  5747. case tab_mark:
  5748. c= 040;if(*(k-1)==040)k--;/* Compress white space. */
  5749. break;
  5750.  
  5751. case 073:
  5752. c= interior_semi;
  5753. break;
  5754. }
  5755.  
  5756. *k= c;
  5757. }
  5758.  
  5759. if(k>=mod_end){
  5760. SET_COLOR(warning);
  5761. printf("\n! Section name too long: ");
  5762.  
  5763. ASCII_write(mod_text+1,25);
  5764. printf("...");mark_harmless;
  5765. }
  5766.  
  5767. if(*k==040&&k>mod_text)k--;/* Trailing blanks. */
  5768. }
  5769.  
  5770.  
  5771.  
  5772. if(k-mod_text>3&&STRNCMP(k-2,ell,3)==0)
  5773. cur_module= prefix_lookup(mod_text+1,k-3);
  5774. else cur_module= mod_lookup(mod_text+1,k);
  5775.  
  5776. if(cur_module!=NULL)
  5777. {
  5778. set_output_file(cur_module->mod_info->language);/* Get current \
  5779. language. */
  5780. }
  5781.  
  5782. return module_name;
  5783. }
  5784.  
  5785. ;
  5786. }
  5787. break;
  5788.  
  5789. case 072:if(*loc==072)compress(colon_colon);break;
  5790.  
  5791. }
  5792.  
  5793.  
  5794.  
  5795.  
  5796. return(eight_bits)c;
  5797. }
  5798.  
  5799.  
  5800.  
  5801. GOTO_CODE get_control_code(VOID)
  5802. {
  5803. eight_bits cc;/* The |ccode| value. */
  5804.  
  5805. c= *loc++;
  5806. SET_CASE(c);/* Set the |upper_case_code| flag. */
  5807.  
  5808. if(c==(ASCII)begin_comment1||c==(ASCII)begin_comment0)
  5809. {
  5810. c= *(loc-1)= 057;/* So we can handle this uniformly with C-style \
  5811. comments. */
  5812. strt_cmnt= YES;
  5813. }
  5814.  
  5815. switch(cc= ccode[c])
  5816. {
  5817. case ignore:return MORE_PARSE;/* Undefined control code. */
  5818.  
  5819. /* Languages are stored, if necessary, in two parts: |begin_language|, and \
  5820. the language itself. Here |set_output_file| sets the language, which can be \
  5821. looked at when we're appending. */
  5822.  
  5823.  
  5824. case begin_C:
  5825. case begin_RATFOR:
  5826. case begin_FORTRAN:
  5827. case begin_LITERAL
  5828.  
  5829.  
  5830.  
  5831. :
  5832. loc--;
  5833.  
  5834. case L_switch:
  5835. {
  5836.  
  5837. {
  5838. ASCII l= *loc++;/* The basic language letter. */
  5839.  
  5840. switch(l)
  5841. {
  5842.  
  5843. case 0143:case 0103
  5844.  
  5845. :
  5846. Cpp= BOOLEAN(*loc==053);
  5847. break;
  5848.  
  5849.  
  5850. case 0162:case 0122
  5851.  
  5852. :
  5853.  
  5854. case 0156:case 0116
  5855.  
  5856. :
  5857. Fortran88= BOOLEAN(*loc==071);
  5858. break;
  5859.  
  5860.  
  5861. case 0166:case 0126
  5862.  
  5863.  
  5864.  
  5865. :
  5866.  
  5867. case 0170:case 0130
  5868.  
  5869. :
  5870. break;
  5871.  
  5872. default:
  5873.  
  5874. err0_print(ERR_C,OC("! Invalid language command `@L%c' ignored"),1,XCHR(l));
  5875. break;
  5876. }
  5877.  
  5878. opt_args(l);/* Set the language, and parse optional arguments after \
  5879.         language command. */
  5880. }
  5881.  
  5882.  
  5883.  
  5884. set_output_file(language);
  5885. return begin_language;
  5886. }
  5887.  
  5888. case control_text:while((c= skip_ahead(ignore,NO))==0100);
  5889. /* only \.{@@} and \.{@>} are expected *//* Is |c| used?? */
  5890.  
  5891. if(*(loc-1)!=076)
  5892.  
  5893. err0_print(ERR_T,OC("Improper @ within control text %s"),1,BTRANS);
  5894.  
  5895.  
  5896. return MORE_PARSE;/* To top of loop in |get_next|. */
  5897.  
  5898. case module_name:/* \.{@<} */
  5899. mac_mod_name= NO;/* Used as a flag for macro processing. */
  5900.  
  5901. {
  5902. ASCII HUGE*k;/* pointer into |mod_text| */
  5903. static ASCII ell[]= "\56\56\56";
  5904.  
  5905.  
  5906.  
  5907. {
  5908. int mlevel= 1;/* For nested module names. */
  5909.  
  5910. k= mod_text;
  5911.  
  5912. WHILE()
  5913. {
  5914. if(loc>limit&&!get_line())
  5915. {
  5916.  
  5917. err0_print(ERR_T,OC("Input ended in section name %s"),1,BTRANS);
  5918.  
  5919. loc= cur_buffer+1;break;
  5920. }
  5921.  
  5922. c= *loc;
  5923.  
  5924.  
  5925. if(c==0100)
  5926. {
  5927. c= *(loc+1);
  5928.  
  5929. if(c==076)
  5930. {
  5931. if(--mlevel==0)
  5932. {
  5933. loc+= 2;break;/* Successful; position after \.{@>}. */
  5934. }
  5935. }
  5936. else if(c==074)mlevel++;
  5937.  
  5938. if(ccode[c]==new_module)
  5939. {
  5940.  
  5941. err0_print(ERR_T,OC("Section name %s didn't end"),1,BTRANS);
  5942.  
  5943. break;
  5944. }
  5945.  
  5946. *(++k)= 0100;loc++;/* Now |c==*loc| again. */
  5947. }
  5948.  
  5949. ;
  5950. loc++;
  5951.  
  5952. if(k<mod_end)k++;
  5953.  
  5954. switch(c)
  5955. {
  5956. case 040:
  5957. case tab_mark:
  5958. c= 040;if(*(k-1)==040)k--;/* Compress white space. */
  5959. break;
  5960.  
  5961. case 073:
  5962. c= interior_semi;
  5963. break;
  5964. }
  5965.  
  5966. *k= c;
  5967. }
  5968.  
  5969. if(k>=mod_end){
  5970. SET_COLOR(warning);
  5971. printf("\n! Section name too long: ");
  5972.  
  5973. ASCII_write(mod_text+1,25);
  5974. printf("...");mark_harmless;
  5975. }
  5976.  
  5977. if(*k==040&&k>mod_text)k--;/* Trailing blanks. */
  5978. }
  5979.  
  5980.  
  5981.  
  5982. if(k-mod_text>3&&STRNCMP(k-2,ell,3)==0)
  5983. cur_module= prefix_lookup(mod_text+1,k-3);
  5984. else cur_module= mod_lookup(mod_text+1,k);
  5985.  
  5986. if(cur_module!=NULL)
  5987. {
  5988. set_output_file(cur_module->mod_info->language);/* Get current \
  5989. language. */
  5990. }
  5991.  
  5992. return module_name;
  5993. }
  5994.  
  5995. ;
  5996.  
  5997. case stringg:/* \.{@=} */
  5998.  
  5999. {
  6000. id_first= loc;/* This used to be |loc++|, but that doesn't handle null \
  6001.         string correctly. */
  6002.  
  6003. *(limit+1)= 0100;*(limit+2)= 076;/* Delimiters for verbatim string. */
  6004.  
  6005. while(*loc!=0100||*(loc+1)!=076)
  6006. loc++;/* Verbatim string must end on same line. */
  6007.  
  6008. if(loc>=limit)
  6009. err0_print(ERR_T,OC("Verbatim string %s didn't end"),1,BTRANS);
  6010.  
  6011.  
  6012. id_loc= loc;
  6013. loc+= 2;/* Just after \.{@>}. */
  6014. return stringg;
  6015. }
  6016.  
  6017. ;
  6018.  
  6019. case begin_vcmnt:
  6020. /* Here the |strt_cmnt| handles all comments verbatim; the last two \
  6021. cases handle~\.{@\slashstar} or~\.{@//}. */
  6022. if(strt_cmnt||*loc==052||*loc==057)
  6023. if(!(scanning_defn&&is_WEB_macro)&&!deferred_macro)
  6024. {
  6025. if(!strt_point_cmnt)long_comment= 
  6026. BOOLEAN(!(*loc==057));
  6027.  
  6028. {
  6029. loc--;/* Position to the beginning slash or comment marker (which has been \
  6030.         already read as part of~`\.{@/}'). */
  6031.  
  6032. id_first= id_loc= mod_text+1;/* A convenient place to put the verbatim \
  6033.                     comment. */
  6034.  
  6035. if(!C_LIKE(language))
  6036. {
  6037. loc++;/* Skip the opening \.*, for beauty. */
  6038.  
  6039. {
  6040. if(R66)*id_loc++= 043;
  6041. else*id_loc++= 012;
  6042.  
  6043. }
  6044.  
  6045. ;
  6046. }
  6047.  
  6048. WHILE()
  6049. {
  6050. if(loc>limit)
  6051. if(!long_comment)
  6052. {
  6053. if(C_LIKE(language))
  6054. {/* If we're not using \Cpp, we'll change short comments back to \
  6055. standard form so they can be understood by the compiler. */
  6056. if(!long_comment&&!Cpp)
  6057. {
  6058. *id_loc++= id_first[1]= 052;
  6059. *id_loc++= id_first[0]= 057;
  6060. }
  6061. }
  6062. else
  6063. {/* In \Fortran, kill off the trailing terminator. */
  6064. if(long_comment)id_loc-= 2;
  6065. }
  6066.  
  6067. break;
  6068. }
  6069.  
  6070.  
  6071. else if(!get_line())
  6072. {
  6073.  
  6074. err0_print(ERR_T,OC("Input ended in verbatim comment %s"),1,BTRANS);
  6075.  
  6076. loc= cur_buffer+1;
  6077. break;
  6078. }
  6079. else
  6080. {
  6081. *id_loc++= 012;/* Retain line breaks in comments. */
  6082.  
  6083. if(R66)
  6084. {
  6085. *id_loc++= 043;/* Special comment line. */
  6086. *id_loc++= 040;/* Space adds readability. */
  6087. }
  6088. }
  6089.  
  6090. if(id_loc<mod_end-3)
  6091. *id_loc++= *loc++;/* Copy over the comment. */
  6092. else
  6093. {
  6094. SET_COLOR(warning);
  6095. printf("\n! Verbatim comment too long: ");
  6096.  
  6097. ASCII_write(mod_text,25);
  6098. printf("...");mark_harmless;
  6099.  
  6100. id_loc= mod_end-3;
  6101. *id_loc++= 052;*id_loc++= 057;/* Terminate the comment \
  6102. (prematurely). */
  6103. comment_continues= YES;/* This is so |get_next| can skip \
  6104. the remainder of the comment. */
  6105. goto finish_vcmnt;
  6106. }
  6107.  
  6108. /* Check for end of verbatim comment. */
  6109. if(long_comment&&*loc==057&&*(loc-1)==052)
  6110. {
  6111. *id_loc++= *loc++;/* Position after end of comment. */
  6112.  
  6113. {
  6114. if(C_LIKE(language))
  6115. {/* If we're not using \Cpp, we'll change short comments back to \
  6116. standard form so they can be understood by the compiler. */
  6117. if(!long_comment&&!Cpp)
  6118. {
  6119. *id_loc++= id_first[1]= 052;
  6120. *id_loc++= id_first[0]= 057;
  6121. }
  6122. }
  6123. else
  6124. {/* In \Fortran, kill off the trailing terminator. */
  6125. if(long_comment)id_loc-= 2;
  6126. }
  6127.  
  6128. break;
  6129. }
  6130.  
  6131.  
  6132. }
  6133. }
  6134.  
  6135. finish_vcmnt:
  6136. if(!C_LIKE(language))
  6137. {
  6138. *id_loc++= '\0';
  6139. }
  6140. return stringg;/* Complete comment copied. */
  6141. }
  6142.  
  6143.  
  6144. /* \.{@\slashstar} */
  6145. }
  6146. else return GOTO_SKIP_A_COMMENT;
  6147. else return MORE_PARSE;/* The line-break command \.{@/} is ignored by \
  6148. \TANGLE. */
  6149.  
  6150. case invisible_cmnt:
  6151. /* When we sense an \.{@\%}, we throw away everything to the end of line, \
  6152. including the newline that is normally returned.  */
  6153. if(*loc==045)
  6154. eat_blank_lines= YES;
  6155.  
  6156. loc= limit+1;/* Force the next line to be read. */
  6157. suppress_newline= YES;
  6158. return MORE_PARSE;
  6159.  
  6160. case compiler_directive:
  6161. {
  6162. int n;
  6163. outer_char*s= t_style.cdir_start[language_num];
  6164.  
  6165. id_first= id_loc= mod_text+1;
  6166.  
  6167. *id_loc++= cdir;
  6168.  
  6169. /* Starting ``pragma'' string. */
  6170. STRCPY(id_loc,s);
  6171. to_ASCII((outer_char HUGE*)id_loc);
  6172. id_loc+= STRLEN(s);
  6173.  
  6174. /* Body. */
  6175. STRNCPY(id_loc,loc,n= limit-loc);
  6176. id_loc+= n;
  6177.  
  6178. *id_loc++= cdir;
  6179. *id_loc++= '\0';
  6180.  
  6181. loc= limit+1;
  6182. return stringg;
  6183. }
  6184.  
  6185. case Compiler_Directive:
  6186. {
  6187. outer_char*s= t_style.cdir_start[language_num];
  6188.  
  6189. id_first= id_loc= mod_text+1;
  6190.  
  6191. *id_loc++= cdir;
  6192. preprocessing= in_cdir= YES;
  6193. at_beginning= NO;
  6194.  
  6195. /* Starting ``pragma'' string. */
  6196. STRCPY(id_loc,s);
  6197. to_ASCII((outer_char HUGE*)id_loc);
  6198. id_loc+= STRLEN(s);
  6199.  
  6200. return stringg;
  6201. }
  6202.  
  6203. case new_output_file:/* \.{@o} */
  6204.  
  6205. {
  6206. while(*loc==' '||*loc==tab_mark)
  6207. {
  6208. loc++;
  6209. if(loc>limit)return ignore;
  6210. }
  6211.  
  6212. id_first= loc;
  6213. while(*loc!=' '&&*loc!=tab_mark)loc++;/* Absorb file name. */
  6214. id_loc= loc;
  6215. if(*id_first=='"')id_first++;
  6216. if(*(id_loc-1)=='"')id_loc--;
  6217. if(id_loc-id_first>=MAX_FILE_NAME_LENGTH)
  6218. {
  6219.  
  6220. err0_print(ERR_T,OC("Output file name too long; allowed only %d characters"),1,MAX_FILE_NAME_LENGTH-1);
  6221. id_loc= id_first+MAX_FILE_NAME_LENGTH-1;
  6222. }
  6223. }
  6224.  
  6225.  
  6226.  
  6227. loc= limit+1;/* Skip rest of line. */
  6228. return cc;
  6229.  
  6230. case ascii_constant:/* \.{@'} or \.{@"} */
  6231. if(translate_ASCII)
  6232. {
  6233. ASCII delim= *(loc-1);/* Character that started the string. */
  6234.  
  6235. id_first= loc-1;/* Include the delimiter for later reference. */
  6236.  
  6237. while(*loc!=delim)
  6238. {
  6239. if(*loc==0134)
  6240. if(*++loc==delim)
  6241. {/* Skip over escape, and possibly escaped \
  6242. delimiter. */
  6243. loc++;
  6244. continue;
  6245. }
  6246.  
  6247. loc++;
  6248.  
  6249. if(loc>limit)
  6250. {
  6251.  
  6252. err0_print(ERR_T,OC("ASCII string %s didn't end"),1,BTRANS);
  6253. loc= limit-1;break;
  6254. }
  6255. }
  6256.  
  6257. loc++;/* Skip closing delimiter. */
  6258. return ascii_constant;
  6259. }
  6260.  
  6261.  
  6262. else
  6263. {
  6264. c= *(loc-1);/* The starting quote character. */
  6265. return GOTO_GET_A_STRING;
  6266. }
  6267.  
  6268. case big_line_break:/* \.{@\#}. Serves double duty as line break or \
  6269. preprocessor command. ??? GENERALIZE??? */
  6270. if(loc>=limit)return MORE_PARSE;
  6271.  
  6272.  
  6273. {
  6274. boolean mcode;
  6275.  
  6276. *limit= ' ';/* Terminator for identifier search. */
  6277. id_first= loc;
  6278.  
  6279. while(isAlpha(*loc))loc++;/* Find end of identifier. */
  6280.  
  6281. if((mcode= is_mcmd(mcmds,id_first,loc))!=0)
  6282. {
  6283. while(loc<limit&&(*loc==040||*loc==tab_mark))
  6284. loc++;
  6285.  
  6286. return mcode;
  6287. }
  6288.  
  6289. loc= id_first;/* Failed to recognize preprocessor command. */
  6290. }
  6291.  
  6292.  
  6293. ;
  6294. return MORE_PARSE;
  6295.  
  6296. case USED_BY_NEITHER:
  6297.  
  6298. err0_print(ERR_T,OC("Invalid `@%c' ignored"),1,XCHR(c));
  6299. return ignore;
  6300.  
  6301. default:return cc;
  6302. }
  6303. }
  6304.  
  6305.  
  6306. #endif /* |part == 2| */
  6307.  
  6308. #if(part == 0 || part == 3)
  6309.  
  6310.  
  6311. SRTN scan_repl FCN((t,stop))
  6312. eight_bits t C0("Either |macro| or |module_name|.")
  6313. boolean stop C1("IF |YES|, stops the scan at the end of current\
  6314. line.")
  6315. {
  6316. eight_bits a0= ignore;/* the current token */
  6317. sixteen_bits a;/* An identifier number. */
  6318. LANGUAGE language0;
  6319. int ntoken= 2;
  6320. boolean auto_bp= YES;/* Breakpoints are inserted automatically, unless \
  6321. the module starts off with \.{@\lb}. */
  6322. boolean scanning_meta= NO;
  6323.  
  6324. language0= language;/* Save incoming language, in case while we're \
  6325.             reading ahead we change it. */
  6326. stop_the_scan= stop;
  6327.  
  6328. if(t==module_name)
  6329. ins_ln_no()
  6330.  
  6331. ;
  6332. else if(stop)
  6333.  
  6334. {
  6335. *limit= 040;
  6336. *(limit+1)= 0100;
  6337. *(limit+2)= 0155;
  6338. }
  6339.  
  6340.  
  6341.  
  6342. WHILE()
  6343. {
  6344. if(stop)
  6345. {
  6346. while(loc<=limit)
  6347. if(*loc!=040)break;
  6348. else loc++;
  6349.  
  6350. if(loc>limit)goto done;
  6351. }
  6352.  
  6353. /* The |ntoken| counter starts out at~2. It is used to see whether the \
  6354. first thing in the module is a left brace. If so, the |_BP| macro is \
  6355. inserted after the brace for debugging purposes. */
  6356. if(ntoken)
  6357. ntoken--;
  6358.  
  6359. a0= (ntoken&&nuweb_mode&&t==module_name)
  6360. ?begin_meta:get_next();/* !!!!! */
  6361.  
  6362. reswitch:
  6363. switch(a0)
  6364. {
  6365. case 0134:
  6366. if(loc==limit&&language!=LITERAL)
  6367. {
  6368. if(!get_line())
  6369. FATAL("!! Input ended while scanning \
  6370. WEB preprocessor statement","");
  6371.  
  6372. {
  6373. *limit= 040;
  6374. *(limit+1)= 0100;
  6375. *(limit+2)= 0155;
  6376. }
  6377.  
  6378.  
  6379. }
  6380. else
  6381. {
  6382. app_repl(a0);
  6383.  
  6384. if(language==LITERAL)
  6385. loc++;
  6386. }
  6387. break;
  6388.  
  6389. case 043:
  6390. if(t==macro&&is_WEB_macro)
  6391.  
  6392. {
  6393. switch(*loc)
  6394. {
  6395. case 072:
  6396.  
  6397. {
  6398. outer_char temp[N_IDBUF];
  6399. ASCII HUGE*t;
  6400.  
  6401.  
  6402. loc++;/* Move past the colon. */
  6403.  
  6404. /* Check if it's '\.0'---immediate statement number. If not, pass it \
  6405. through to the output phase. */
  6406. if(*loc!=060)
  6407. {
  6408. app_repl(043);
  6409. app_repl(072);
  6410. break;
  6411. }
  6412.  
  6413. loc++;/* Move past the zero.*/
  6414.  
  6415. if(
  6416. nsprintf(temp,OC("%lu"),1,max_stmt++)>=(int)(N_IDBUF))OVERFLW("temp","");/* Make the number. */
  6417. to_ASCII(temp);
  6418.  
  6419. /* Append the number, bracketed by |constant|. */
  6420. app_repl(constant);
  6421.  
  6422. for(t= (ASCII*)temp;*t!='\0';t++)app_repl(*t);
  6423.  
  6424. app_repl(constant);
  6425. }
  6426.  
  6427. break;
  6428.  
  6429. case 041:
  6430. if(scanning_defn)
  6431. {
  6432. sixteen_bits a;
  6433.  
  6434.  
  6435. loc++;/* Position to after `\.!'. */
  6436.  
  6437. if(get_next()!=identifier)
  6438.  
  6439. err0_print(ERR_M,OC("Identifier must follow #!; command ignored"),0);
  6440. else
  6441. {
  6442. text_pointer m;
  6443.  
  6444. /* Add the identifier to the table if necessary. */
  6445. a= ID_NUM(id_first,id_loc);
  6446.  
  6447. /* If it's an identifier but not a macro, it must be the construction \
  6448. `\.{\#!}|arg|'; just append that for later processing. */
  6449. if((m= MAC_LOOKUP(a))==NULL)
  6450. {
  6451. app_repl(043);
  6452. app_repl(041);
  6453.  
  6454. {
  6455. app_repl(LEFT(a,ID0));
  6456. app_repl(RIGHT(a));
  6457. }
  6458.  
  6459. ;
  6460. break;
  6461. }
  6462. else
  6463. if(m->nargs>0)
  6464.  
  6465. err0_print(ERR_M,OC("Macro after #! may not have arguments"),0);
  6466. else
  6467. {
  6468. eight_bits HUGE*q0,HUGE*q1;
  6469.  
  6470.  
  6471. q0= m->tok_start+m->moffset;
  6472. q1= (m+1)->tok_start;
  6473.  
  6474. /* Just copy the definition without expanding. */
  6475. while(q0<q1)app_repl(*q0++);
  6476. }
  6477.  
  6478.  
  6479. }
  6480. }
  6481.  
  6482.  
  6483. else app_repl(043);
  6484. break;
  6485.  
  6486. case 047:
  6487. case 042:
  6488. app_repl(a0);
  6489. app_repl(*loc++);
  6490. break;
  6491.  
  6492. default:
  6493.  
  6494. {
  6495. sixteen_bits a;
  6496.  
  6497.  
  6498. if(isDigit(*loc)||*loc==054||*loc==046||*loc==052||*loc==056||
  6499. *loc==0133||*loc==0173)
  6500. /* It's one of the forms `\.{\#}$nnn$', `\.{\#,}', `\.{\#\&}', `\.{\#*}', \
  6501. or `\.{\#.}'; these are processed on output. */
  6502. {app_repl(043);}
  6503. else if(get_next()!=identifier)
  6504.  
  6505. macro_err(OC("! '#' should be followed by identifier"),YES);
  6506. else
  6507. {
  6508. a= ID_NUM(id_first,id_loc);
  6509.  
  6510. /* Check to see if the identifier is an already-defined macro; if not, it's \
  6511. the stringizing operation, which is processed on output; just \
  6512. append the identifier. */
  6513. if((MAC_LOOKUP(a))==NULL)
  6514. {
  6515. app_repl(043);
  6516.  
  6517. {
  6518. app_repl(LEFT(a,ID0));
  6519. app_repl(RIGHT(a));
  6520. }
  6521.  
  6522. ;
  6523. break;
  6524. }
  6525.  
  6526. /* Asking for immediate expansion of macro. */
  6527.  
  6528. macro_err(OC("! Immediate expansion of macro \"%s\" not implemented"),YES,name_of(a));
  6529.  
  6530. {
  6531. app_repl(LEFT(a,ID0));
  6532. app_repl(RIGHT(a));
  6533. }
  6534.  
  6535. ;
  6536. }
  6537. }
  6538.  
  6539.  
  6540. break;
  6541. }
  6542. }
  6543.  
  6544.  
  6545. else
  6546. {
  6547. app_repl(a0);
  6548. }
  6549. break;
  6550.  
  6551.  
  6552.  
  6553. case identifier:
  6554.  
  6555.  
  6556. a= ID_NUM(id_first,id_loc);
  6557.  
  6558. {
  6559. app_repl(LEFT(a,ID0));
  6560. app_repl(RIGHT(a));
  6561. }
  6562.  
  6563.  
  6564.  
  6565.  
  6566. break;
  6567.  
  6568. case module_name:
  6569. /* In a macro, the appearance of a module name beginning with \
  6570.     \.{@<} ends the macro and the definition section. On the other \
  6571. hand, the construction \.{\#<\dots@>} is OK in a macro. */
  6572. if(t==macro&&!mac_mod_name)
  6573. goto done;
  6574. else
  6575. {
  6576.  
  6577. {
  6578. ASCII HUGE*try_loc= loc;
  6579.  
  6580.  
  6581. while(*try_loc==040&&try_loc<limit)try_loc++;
  6582. if(*try_loc==053&&try_loc<limit)try_loc++;
  6583. while(*try_loc==040&&try_loc<limit)try_loc++;
  6584. if(*try_loc==075)
  6585.  
  6586. err0_print(ERR_T,OC("Nested named modules.  Missing `@*' or `@ '?"),0);
  6587.  
  6588. }
  6589.  
  6590. ;
  6591. a= cur_module-name_dir;
  6592. app_repl(LEFT(a,0250));
  6593. app_repl(RIGHT(a));
  6594. ins_ln_no()
  6595.  
  6596. ;
  6597. if(nuweb_mode)
  6598. {/* !!!!! */
  6599. a0= begin_meta;
  6600. goto reswitch;
  6601. }
  6602. break;
  6603. }
  6604.  
  6605. case constant:
  6606. case stringg:
  6607.  
  6608.  
  6609. if(C_LIKE(language))
  6610. if(bin_constant&&a0==constant)
  6611. {
  6612. app_converted(btoi(id_first,id_loc));/* Start after the \.{0x}. */
  6613. }
  6614.  
  6615.  
  6616. else copy_string(a0);
  6617. else if(a0==constant)
  6618. if(hex_constant)
  6619. {
  6620. app_converted(xtoi(id_first,id_loc));/* Start after the \.{0x}. */
  6621. }
  6622.  
  6623.  
  6624. else if(bin_constant)
  6625. {
  6626. app_converted(btoi(id_first,id_loc));/* Start after the \.{0x}. */
  6627. }
  6628.  
  6629.  
  6630. else if(starts_with_0&&!floating_constant)
  6631. {
  6632. app_converted(otoi(id_first,id_loc));
  6633. }
  6634.  
  6635.  
  6636. else copy_string(a0);
  6637. else if(R77&&a0==stringg&&!in_format)
  6638. if(*id_first==047)rdc_char_constant();
  6639. else
  6640. {
  6641. /* Replace the Ratfor double quote with Fortran's single quote. Watch out \
  6642. for a verbatim comment that doesn't start with quote at all. */
  6643. if(*id_first==042)*id_first= *(id_loc-1)= 047;
  6644. copy_string(a0);
  6645. }
  6646. else copy_string(a0);
  6647.  
  6648. break;
  6649.  
  6650. ;
  6651.  
  6652. case ascii_constant:
  6653. cp_ASCII();
  6654. break;
  6655.  
  6656. case begin_meta:
  6657.  
  6658. {
  6659. app_repl(stringg);
  6660. app_repl(a0);/* |begin_meta| inside strings means to insert the \
  6661.         |meta| stuff from the style file. */
  6662.  
  6663. if(FORTRAN_LIKE(language))
  6664. {
  6665. column_mode= NO;
  6666. app_repl(012);
  6667. }
  6668.  
  6669. scanning_meta= YES;
  6670.  
  6671. }
  6672.  
  6673.  
  6674. break;
  6675.  
  6676. case end_meta:
  6677.  
  6678.  
  6679. if(FORTRAN_LIKE(language)&&!free_form_input)
  6680.  
  6681. {
  6682. loc= limit+1;
  6683. column_mode= YES;
  6684. parsing_mode= OUTER;
  6685. }
  6686.  
  6687.  
  6688.  
  6689. ;
  6690. get_line();
  6691. app_repl(end_meta);
  6692. app_repl(stringg);
  6693. scanning_meta= NO;
  6694. break;
  6695.  
  6696. case dot_const:
  6697. app_repl(a0);
  6698. app_repl(dot_op.num);/* |dot_op| was filled by |dot_code|. */
  6699. break;
  6700.  
  6701. case begin_language:
  6702. switch(language)
  6703. {
  6704. case NO_LANGUAGE:
  6705. CONFUSION("scan_repl:begin_language","Language isn't defined");
  6706.  
  6707. case RATFOR:
  6708. case RATFOR_90:
  6709. if(!RAT_OK("(scan_repl)"))
  6710. CONFUSION("scan_repl:begin_language",
  6711. "Attempting to append @Lr");
  6712.  
  6713. case C:
  6714. case C_PLUS_PLUS:
  6715. case LITERAL:
  6716. column_mode= NO;
  6717. break;
  6718.  
  6719. case FORTRAN:
  6720. case FORTRAN_90:
  6721. case TEX:
  6722. if(!(scanning_defn||free_form_input))
  6723.  
  6724. {
  6725. loc= limit+1;
  6726. column_mode= YES;
  6727. parsing_mode= OUTER;
  6728. }
  6729.  
  6730.  
  6731. break;
  6732.  
  6733. default:
  6734. CONFUSION("app_id","Invalid language");
  6735. }
  6736.  
  6737. /* We append the language in two parts: |begin_language|, and the language \
  6738. itself. This is so we didn't have to tie up many non-printable |ASCII| \
  6739. tokens. See the inverse code in |get_output|. */
  6740. set_output_file(language);
  6741. if(!scanning_defn)
  6742. {app_repl(a0);app_repl((eight_bits)language);}
  6743.  
  6744. {
  6745. store_two_bytes((sixteen_bits)(LINE_NUM+module_count));
  6746. }
  6747.  
  6748.  
  6749. ins_ln_no()
  6750.  
  6751. ;
  6752. break;
  6753.  
  6754. case no_mac_expand:
  6755. app_repl(begin_language);
  6756. app_repl(a0);
  6757. break;
  6758.  
  6759. case new_output_file:
  6760. if(t==macro)
  6761. goto done;
  6762. else
  6763. {
  6764. name_pointer np;
  6765.  
  6766. app_repl(begin_language);/* We piggy-back on |begin_language|. */
  6767. app_repl(NO_LANGUAGE);
  6768. app_repl(upper_case_code);/* Scope of file name: \
  6769. \.{@o}~means local; \.{@O}~means global. */
  6770. a= ID_NUM_ptr(np,id_first,id_loc);
  6771.  
  6772. {
  6773. app_repl(LEFT(a,ID0));
  6774. app_repl(RIGHT(a));
  6775. }
  6776.  
  6777.  
  6778. np->macro_type= FILE_NAME;/* To prevent truncations. */
  6779.  
  6780. if(nuweb_mode)
  6781. {
  6782. a0= begin_meta;
  6783. goto reswitch;
  6784. }
  6785. }
  6786. break;
  6787.  
  6788. case WEB_definition:
  6789. if(t==macro)
  6790. goto done;
  6791. else
  6792. {
  6793.  
  6794. {
  6795. #define NAME_LEN 100
  6796.  
  6797. name_pointer np;
  6798. eight_bits HUGE*tok_ptr0,HUGE*tok_m_end0;
  6799. text_pointer text_ptr0,text_end0;
  6800. outer_char new_name[NAME_LEN];
  6801. ASCII HUGE*nn,HUGE*b;
  6802. sixteen_bits a;
  6803.  
  6804. if(!deferred_macros)
  6805. {
  6806.  
  6807. err0_print(ERR_T,OC("Sorry, deferred WEB macros (defined in code part) are \
  6808. prohibited; use option `-TD' to permit them"),0);
  6809. continue;
  6810. }
  6811.  
  6812. tok_ptr0= tok_ptr;
  6813. tok_m_end0= tok_m_end;
  6814. text_ptr0= text_ptr;
  6815. text_end0= text_end;
  6816.  
  6817. tok_ptr= tok_dptr;
  6818. tok_m_end= tokd_end;
  6819. text_ptr= txt_dptr;
  6820. text_end= textd_end;
  6821.  
  6822. deferred_macro= YES;
  6823. np= app_macro(WEB_definition);
  6824. deferred_macro= NO;
  6825.  
  6826. tok_dptr= tok_ptr;
  6827. tok_ptr= tok_ptr0;
  6828. tok_m_end= tok_m_end0;
  6829.  
  6830. txt_dptr= text_ptr;
  6831. text_ptr= text_ptr0;
  6832. text_end= text_end0;
  6833.  
  6834. if(np==NULL)continue;
  6835.  
  6836. /* Create a unique name, beginning with '@'. */
  6837.  
  6838. if(
  6839. nsprintf(new_name,OC("@%d"),1,n_unique++)>=(int)(NAME_LEN))OVERFLW("new_name","");
  6840. to_ASCII(new_name);
  6841. for(nn= (ASCII*)new_name+STRLEN(new_name),b= np->byte_start;
  6842. b<(np+1)->byte_start;)
  6843. *nn++= *b++;
  6844.  
  6845. a= ID_NUM_ptr(np,(ASCII*)new_name,nn);
  6846.  
  6847. {
  6848. app_repl(LEFT(a,ID0));
  6849. app_repl(RIGHT(a));
  6850. }
  6851.  
  6852. ;
  6853.  
  6854. np->macro_type= DEFERRED_MACRO;
  6855. np->equiv= (EQUIV)cur_text;
  6856.  
  6857. #undef NAME_LEN
  6858. }
  6859.  
  6860. ;
  6861. continue;
  6862. }
  6863.  
  6864. case begin_nuweb:
  6865. if(t!=module_name)
  6866. {
  6867. nuweb_mode1= !NUWEB_MODE;
  6868. goto done;
  6869. }
  6870. else
  6871. {
  6872.  
  6873. err0_print(ERR_W,OC("@N ignored; must appear before beginning of code part"),0);
  6874. continue;
  6875. }
  6876.  
  6877. case formatt:
  6878. case limbo_text:case op_def:case macro_def:
  6879. case definition:case undefinition:
  6880. case begin_code:
  6881. if(t!=module_name)
  6882. goto done;
  6883. else
  6884. {
  6885.  
  6886. err0_print(ERR_T,OC("@d, @l, @v, @w, @u, @f, and @a \
  6887. are ignored in code text"),0);
  6888. continue;
  6889.  
  6890. }
  6891.  
  6892. case end_of_buffer:
  6893. a0= ignore;
  6894.  
  6895. case m_ifdef:case m_ifndef:
  6896. case m_if:case m_else:case m_elif:case m_endif:case m_undef:case m_pragma:
  6897. case m_for:case m_endfor:
  6898. case new_module:
  6899. goto done;
  6900.  
  6901.  
  6902.  
  6903.  
  6904. case 012:
  6905. /* As far as checking whether a left brace begins a module, we don't care \
  6906. about newlines. */
  6907. if(ntoken)ntoken++;
  6908. app_repl(a0);
  6909. break;
  6910.  
  6911. case 0173:
  6912. app_repl(a0);
  6913.  
  6914. if(ntoken&&breakpoints&&t==module_name&&auto_bp)
  6915.  
  6916. {
  6917. ASCII bp_cmd[BP_BUF_SIZE];
  6918.  
  6919. if(cur_module!=NULL)
  6920. {
  6921.  
  6922. if(
  6923. nsprintf(bp_cmd,OC("_BP(%d,\"%s\")"),2,module_count,name_of((sixteen_bits)(cur_module-name_dir)))>=(int)(BP_BUF_SIZE))OVERFLW("bp_cmd","");
  6924. to_ASCII(OC(bp_cmd));
  6925. divert(bp_cmd,bp_cmd+STRLEN(bp_cmd),DONT_STOP);
  6926. }
  6927. }
  6928.  
  6929.  
  6930.  
  6931. break;
  6932.  
  6933. case begin_bp:
  6934. auto_bp= NO;/* A manual insertion command is coming up. */
  6935. app_repl(0173);
  6936. break;
  6937.  
  6938. case insert_bp:
  6939. if(breakpoints)
  6940.  
  6941. {
  6942. ASCII bp_cmd[BP_BUF_SIZE];
  6943.  
  6944. if(cur_module!=NULL)
  6945. {
  6946.  
  6947. if(
  6948. nsprintf(bp_cmd,OC("_BP(%d,\"%s\")"),2,module_count,name_of((sixteen_bits)(cur_module-name_dir)))>=(int)(BP_BUF_SIZE))OVERFLW("bp_cmd","");
  6949. to_ASCII(OC(bp_cmd));
  6950. divert(bp_cmd,bp_cmd+STRLEN(bp_cmd),DONT_STOP);
  6951. }
  6952. }
  6953.  
  6954.  
  6955. break;
  6956.  
  6957. default:
  6958. app_repl(a0);/* Store |a0| in |tok_mem|. */
  6959. break;
  6960. }
  6961. }
  6962.  
  6963. done:
  6964. if(stop_the_scan&&!from_buffer)
  6965. {
  6966. stop_the_scan= NO;
  6967. next_control= ignore;
  6968. }
  6969. else next_control= 
  6970. (eight_bits)CHOICE((from_buffer&&loc>limit)||stop,
  6971. ignore,a0);
  6972.  
  6973.  
  6974. {
  6975. if(text_ptr>text_end)OVERFLW("texts","x");
  6976. cur_text= text_ptr;
  6977. (++text_ptr)->tok_start= tok_ptr;/* The next start is the present end. */
  6978. }
  6979.  
  6980. ;
  6981. cur_text->Language= (boolean)language0;/* Use the starting language. */
  6982. }
  6983.  
  6984.  
  6985. SRTN ins_ln_no(VOID)
  6986. {
  6987. name_pointer np;
  6988.  
  6989. store_two_bytes((sixteen_bits)LINE_NUM);/* $\equiv$ a mod.\ \# of~0. */
  6990.  
  6991. if(line_info)
  6992. {
  6993. id_first= x_to_ASCII(changing?change_file_name:cur_file_name);
  6994. id_loc= id_first+STRLEN(id_first);
  6995.  
  6996. store_two_bytes((sixteen_bits)(changing?change_line:cur_line));
  6997.  
  6998. store_two_bytes(ID_NUM_ptr(np,id_first,id_loc));
  6999. np->Language= (boolean)NO_LANGUAGE;/* \bfit Is this used??? */
  7000. }
  7001. }
  7002.  
  7003.  
  7004. SRTN copy_string FCN((a0))
  7005. eight_bits a0 C1("")
  7006. {
  7007. app_repl(a0);/* |stringg| or |constant| */
  7008.  
  7009. while(id_first<id_loc)
  7010. {
  7011. if(*id_first==0100)
  7012.  
  7013. if(language==TEX&&*(id_first+1)==0100)id_first++;
  7014. else
  7015. {
  7016. id_first++;/* Character after the~`\.{@}'. */
  7017.  
  7018. switch(ccode[*id_first])
  7019. {
  7020. case 0100:
  7021. break;/* The `\.{@}'~will be stored. */
  7022.  
  7023.  
  7024.  
  7025. case begin_C:
  7026. case begin_RATFOR:
  7027. case begin_FORTRAN:
  7028. case begin_LITERAL
  7029.  
  7030.  
  7031.  
  7032. :
  7033. case L_switch:
  7034. app_repl(0100);
  7035. break;/* Retain the character. */
  7036.  
  7037. default:
  7038. id_first++;/* Discard character after~`\.{@}'. */
  7039. continue;
  7040. }
  7041. }
  7042.  
  7043.  
  7044.  
  7045. app_repl(*id_first++);
  7046. }
  7047.  
  7048. app_repl(a0);/* Bracket the string or constant with the id token. */
  7049. }
  7050.  
  7051.  
  7052.  
  7053. unsigned long xtoi FCN((b,b1))
  7054. CONST ASCII HUGE*b C0("Beginning of string.")
  7055. CONST ASCII HUGE*b1 C1("End of string.")
  7056. {
  7057. unsigned long n= 0;
  7058.  
  7059. for(b+= 2;b<b1;b++)
  7060. {
  7061. n*= 16;
  7062.  
  7063. if(isDigit(*b))n+= *b-060;
  7064. else n+= A_TO_UPPER(*b)-0101+10;
  7065. }
  7066.  
  7067. return n;
  7068. }
  7069.  
  7070.  
  7071. SRTN app_converted FCN((n))
  7072. unsigned long n C1("")
  7073. {
  7074. ASCII temp[N_IDBUF];
  7075. ASCII HUGE*b;
  7076.  
  7077.  
  7078. if(
  7079. nsprintf((outer_char*)(temp),OC("%lu"),1,n)>=(int)(N_IDBUF))OVERFLW("(outer_char*)(temp)","");
  7080. to_ASCII((outer_char*)(temp));
  7081.  
  7082. app_repl(constant);
  7083. for(b= temp;*b!='\0';b++)app_repl(*b)
  7084. app_repl(constant);
  7085. }
  7086.  
  7087.  
  7088.  
  7089. unsigned long otoi FCN((b,b1))
  7090. CONST ASCII HUGE*b C0("Beginning of string.")
  7091. CONST ASCII HUGE*b1 C1("End of string.")
  7092. {
  7093. unsigned long n= 0;
  7094.  
  7095. for(b++;b<b1;b++)
  7096. n= 8*n+*b-060;
  7097.  
  7098. return n;
  7099. }
  7100.  
  7101.  
  7102.  
  7103. unsigned long btoi FCN((b,b1))
  7104. CONST ASCII HUGE*b C0("Beginning of string.")
  7105. CONST ASCII HUGE*b1 C1("End of string.")
  7106. {
  7107. unsigned long n= 0;
  7108.  
  7109. for(b+= 2;b<b1;b++)
  7110. n= 2*n+*b-060;
  7111.  
  7112. return n;
  7113. }
  7114.  
  7115.  
  7116. SRTN rdc_char_constant(VOID)
  7117. {
  7118. int n;
  7119.  
  7120. if(*++id_first==0134)
  7121. switch(*++id_first)
  7122. {
  7123.  
  7124. case 060:n= '\0';break;
  7125. case 0134:n= 0134;break;
  7126. case 047:n= 047;break;
  7127. case 042:n= 042;break;
  7128. case 077:n= 077;break;/* Microsoft doesn't like. */
  7129. case 0141:n= 07;break;/* SGI didn't understand. */
  7130. case 0142:n= 010;break;
  7131. case 0146:n= 014;break;
  7132. case 0156:n= 012;break;
  7133. case 0162:n= 015;break;
  7134. case 0164:n= 011;break;
  7135. case 0166:n= 013;break;
  7136.  
  7137.  
  7138. default:
  7139.  
  7140. err0_print(ERR_T,OC("Invalid escape sequence '\\%c' \
  7141. in Ratfor character constant; null assumed"),1,XCHR(*id_first));
  7142. n= 0;
  7143. break;
  7144. }
  7145. else n= *id_first;
  7146.  
  7147. if(*(id_first+1)!=047)
  7148. err0_print(ERR_T,OC("Ratfor character constant longer \
  7149. than one byte; extra characters ignored"),0);
  7150.  
  7151. app_converted(n);
  7152. }
  7153.  
  7154.  
  7155. SRTN cp_ASCII(VOID)
  7156. {
  7157. if(*id_first++==047)
  7158. {/* Single |ASCII| character. */
  7159. if(C_LIKE(language))app_aconst('o',YES);/* Octal (leading zero). */
  7160. else app_aconst('d',NO);/* Decimal. */
  7161. }
  7162. else
  7163. {/* Do whole string. */
  7164. if(C_LIKE(language))
  7165. {
  7166. app_repl(042);
  7167.  
  7168. while(*id_first!=042)
  7169. {
  7170. app_repl(0134);
  7171. app_aconst('o',NO);/* Octal, no leading zero. */
  7172. }
  7173.  
  7174. app_repl(042);
  7175. }
  7176. else
  7177. {
  7178. sixteen_bits a;
  7179. ASCII delim= (ASCII)(is_RATFOR_(language)?042:047);
  7180. int n= STRLEN(t_style.ASCII_fcn);
  7181.  
  7182. /*  Preface by function call from style file. */
  7183. a= ID_NUM(t_style.ASCII_fcn,t_style.ASCII_fcn+n);
  7184.  
  7185. {
  7186. app_repl(LEFT(a,ID0));
  7187. app_repl(RIGHT(a));
  7188. }
  7189.  
  7190.  
  7191. app_repl(050);
  7192. app_repl(delim);
  7193. while(*id_first!=042)
  7194. app_repl(*id_first++);
  7195. app_repl(delim);
  7196. app_repl(051);
  7197. }
  7198. }
  7199.  
  7200. #if(0) /* Keep around for compilers that can't handle the above. */
  7201. /* Do whole string, essentially converting to form \
  7202. ``\.{@'a',@'b',@'c'}''. */
  7203. app_repl(0173);
  7204.  
  7205. while(*id_first!=042)
  7206. {
  7207. app_aconst(YES);
  7208. app_repl(054);
  7209. }
  7210.  
  7211. app_repl(060);/* String terminator. */
  7212. app_repl(0175);
  7213. }
  7214. #endif
  7215. }
  7216.  
  7217.  
  7218.  
  7219. SRTN app_aconst FCN((fmt_char,leading_zero))
  7220. outer_char fmt_char C0("Either 'o' (octal) or 'd' (decimal)")
  7221. boolean leading_zero C1("For octal format")
  7222. {
  7223. eight_bits n;/* Value of the constant. */
  7224. outer_char value[10],*v;
  7225.  
  7226. if(*id_first==0100)
  7227. {/* The construction `\.{@'@@'}'. */
  7228. n= *id_first++;/* Advance past first~`\.{@}'. */
  7229.  
  7230. if(*id_first!=0100)
  7231. err0_print(ERR_T,OC("Should use double @ within \
  7232. ASCII constant"),0);
  7233. else id_first++;
  7234. }
  7235. else if(*id_first==0134)
  7236. {/* Something like `\.{@'\\040'}' or~`\.{@'\\n'}', or it could \
  7237. be an escaped delimiter. */
  7238. id_first++;/* Advance past the escape character. */
  7239.  
  7240. n= esc_achar((CONST ASCII HUGE*HUGE*)&id_first);
  7241.  
  7242. }
  7243. else n= *id_first++;/* ``Ordinary construction'' like `\.{@'a'}'. */
  7244.  
  7245. /* The following statement is for development while debugging the character \
  7246. set translations.  From a normal \FTANGLE, \.{touch \{ftangle,common\}.web} \
  7247. and run \.{make} with \
  7248. ``\.{DEBUGGING=-mscramble\_ASCII}''.  This adds some extra code to scramble \
  7249. all the |ASCII| constants.  Then define |DEBUG_XCHR| in \
  7250. \.{custom.h} and run \.{make} with ``\.{DEBUGGING=-a}''; this scrambles the \
  7251. |ASCII| constants but also compiles using the new translation table. \
  7252. Hopefully, it should work as before. */
  7253. #ifdef scramble_ASCII
  7254. n= xxord[n];
  7255. #endif
  7256.  
  7257. #ifdef unscramble_ASCII
  7258. n= XCHR(n);
  7259. #endif
  7260.  
  7261. /* Now |n|~has the numerical value of the |ASCII| constant; in octal, it's \
  7262. something like~|0123|.  We now just append the octal representation as a \
  7263. constant. */
  7264. app_repl(constant);
  7265.  
  7266.  
  7267. if(
  7268. nsprintf(value,OC(fmt_char=='o'?"%s%o":"%s%d"),2,leading_zero?"0":"",n)>=(int)(10))OVERFLW("value","");
  7269.  
  7270. for(v= value;*v;v++)
  7271. app_repl(XORD(*v));
  7272.  
  7273. app_repl(constant);
  7274.  
  7275. #if(0) /* Kept around in case compiler can't understand \.{\%o}. */
  7276. int l;
  7277.  
  7278. if(leading_zero)app_repl(060);/* Beginning zero signifies octal constant. */
  7279.  
  7280. value[0]= 060+(n>>6);/* Left-most digit. */
  7281. value[1]= 060+((n-0100*(n>>6))>>3);/* Center digit. */
  7282. value[2]= 060+(n-010*(n>>3));/* Right-most digit. */
  7283.  
  7284. for(l= 0;l<3;l++)
  7285. if(value[l]!=060)break;/* Kill off leading zeros for beauty. */
  7286.  
  7287. for(;l<3;l++)
  7288. app_repl(value[l]);/* Nontrivial part. */
  7289.  
  7290. #endif
  7291. }
  7292.  
  7293.  
  7294.  
  7295. SRTN i_ascii_ FCN((n,pargs))
  7296. int n C0("")
  7297. PARGS pargs C1("")
  7298. {
  7299. int len;/* Length to copy. */
  7300. eight_bits*start= pargs[0]+1;/* Starting address of argument. */
  7301.  
  7302. CHK_ARGS("$A",1);
  7303.  
  7304. if(translate_ASCII)
  7305. {
  7306. eight_bits HUGE*tok_ptr0= tok_ptr;/* Save starting position. */
  7307.  
  7308. if(*start==stringg)id_first= (ASCII HUGE*)(start+1);
  7309. else
  7310. {
  7311.  
  7312. err0_print(ERR_T,OC("Argument of _A should be quoted; \
  7313. just returning argument"),0);
  7314. goto just_return;
  7315. }
  7316.  
  7317. cp_ASCII();/* Build result in the token area. */
  7318.  
  7319. len= tok_ptr-tok_ptr0;
  7320. MCHECK(len,"_ascii_");
  7321. memcpy(mp,tok_ptr0,len);
  7322. tok_ptr= tok_ptr0;/* Reset position. */
  7323. }
  7324. else
  7325. {/* Just return the string argument. */
  7326. just_return:
  7327. len= pargs[1]-start;
  7328. MCHECK(len,"_ascii_");
  7329. STRNCPY(mp,start,len);
  7330. }
  7331.  
  7332. mp+= len;
  7333. }
  7334.  
  7335.  
  7336.  
  7337. SRTN scan_module(VOID)
  7338. {
  7339. name_pointer p= NULL;/* module name for the current module */
  7340.  
  7341. module_count++;
  7342.  
  7343. params= global_params;
  7344. frz_params();
  7345. set_output_file(global_language);
  7346.  
  7347. progress();
  7348.  
  7349.  
  7350. {
  7351. parsing_mode= INNER;
  7352. nuweb_mode1= nuweb_mode;
  7353.  
  7354. next_control= ignore;
  7355.  
  7356. if(module_count==1)
  7357. {
  7358. *(mp-1)= 0100;
  7359. *mp= 0155;
  7360. divert((ASCII HUGE*)macrobuf,(ASCII HUGE*)mp,STOP);/* Begin \
  7361.         reading from \
  7362.         the macro buffer, when some macros were predefined with \
  7363.         |save_macro|. |mp-1| is positioned to the blank after the \
  7364.         last definition. */
  7365. }
  7366.  
  7367. /* Skip \TeX\ stuff and expand the definition section. */
  7368. scanning_TeX= YES;
  7369. scan_text(macro,p,EXPAND);
  7370. scanning_TeX= NO;
  7371.  
  7372. if(module_count==1)
  7373. {
  7374. IN_COMMON ASCII HUGE*pbp;
  7375.  
  7376.  
  7377. breakpoints= BOOLEAN(MAC_LOOKUP(ID_NUM(pbp,pbp+3))!=NULL);
  7378. }
  7379.  
  7380. ;
  7381.  
  7382. if(mlevel!=0)
  7383. {
  7384.  
  7385. err0_print(ERR_M,OC("Invalid preprocessor block structure (level %d). \
  7386. Missing @#endif?"),1,mlevel);
  7387. mlevel= 0;
  7388. }
  7389. }
  7390.  
  7391. ;/* \TeX, \.{@d}, \.{@f}. */
  7392.  
  7393. switch(next_control)
  7394. {
  7395. case begin_code:/* \.{@a} */
  7396. {
  7397. params= global_params;/* The unnamed module has the global state. */
  7398. frz_params();
  7399. set_output_file(global_language);
  7400.  
  7401. p= name_dir;
  7402.  
  7403.  
  7404. if(FORTRAN_LIKE(language)&&!free_form_input)
  7405.  
  7406. {
  7407. loc= limit+1;
  7408. column_mode= YES;
  7409. parsing_mode= OUTER;
  7410. }
  7411.  
  7412.  
  7413.  
  7414. ;
  7415. break;
  7416. }
  7417.  
  7418. case module_name:/* \.{@<} */
  7419. if(cur_module)
  7420. {
  7421. p= cur_module;
  7422. params= cur_module->mod_info->params;/* Restore state. */
  7423. }
  7424. else
  7425. {/* We get here if the module name was bad. */
  7426. /* The above wasn't a good idea.  It's better to flush the module. */
  7427. while((next_control= skip_ahead(ignore,NO))!=new_module);
  7428. return;
  7429. }
  7430.  
  7431.  
  7432. {
  7433. while((next_control= get_next())==053);/* Allow optional `\.{+=}". */
  7434.  
  7435. if(next_control!=075&&next_control!=eq_eq)
  7436. {
  7437.  
  7438. err0_print(ERR_T,OC("Code text of %s flushed; = sign is missing"),1,MTRANS);
  7439.  
  7440.  
  7441. while((next_control= skip_ahead(ignore,NO))!=new_module);
  7442.  
  7443. return;
  7444. }
  7445. }
  7446.  
  7447. ;
  7448. frz_params();
  7449.  
  7450.  
  7451. if(FORTRAN_LIKE(language)&&!free_form_input)
  7452.  
  7453. {
  7454. loc= limit+1;
  7455. column_mode= YES;
  7456. parsing_mode= OUTER;
  7457. }
  7458.  
  7459.  
  7460.  
  7461. ;
  7462. break;
  7463.  
  7464. default:return;
  7465. }
  7466.  
  7467. nuweb_mode= nuweb_mode1;
  7468.  
  7469. /* Possibly turn on nuweb mode for output. */
  7470. app_repl(begin_language);
  7471. app_repl(NUWEB_OFF|nuweb_mode);
  7472.  
  7473. {
  7474. if(text_ptr>text_end)OVERFLW("texts","x");
  7475. cur_text= text_ptr;
  7476. (++text_ptr)->tok_start= tok_ptr;/* The next start is the present end. */
  7477. }
  7478.  
  7479. ;
  7480.  
  7481. next_control= ignore;
  7482. scan_text(module_name,p,EXPAND);/* Expand the code section. */
  7483. column_mode= NO;
  7484.  
  7485. /* Reset nuweb mode. */
  7486. app_repl(begin_language);
  7487. app_repl(NUWEB_OFF|global_params.Nuweb_mode);
  7488.  
  7489. {
  7490. if(text_ptr>text_end)OVERFLW("texts","x");
  7491. cur_text= text_ptr;
  7492. (++text_ptr)->tok_start= tok_ptr;/* The next start is the present end. */
  7493. }
  7494.  
  7495. ;
  7496.  
  7497. ;/* Code. */
  7498. }
  7499.  
  7500.  
  7501.  
  7502. SRTN scan_text FCN((text_type,p,expand))
  7503. int text_type C0("Either |macro| or |module_name|.")
  7504. CONST name_pointer p C0("Module name.")
  7505. boolean expand C1("Do we expand?")
  7506. {
  7507. boolean if_switch;
  7508. boolean scanned_if= NO;
  7509. boolean first_text= YES;
  7510. eight_bits HUGE*pp;
  7511. text_pointer q;
  7512.  
  7513. scanning_defn= BOOLEAN(text_type==macro);
  7514.  
  7515. if(++mlevel>=MAX_LEVEL)
  7516. FATAL("!! Conditional nesting depth exceeded","");/* Increment and \
  7517. remember the incoming processing level. */
  7518.  
  7519. WHILE()
  7520. {
  7521. if(scanning_defn&&expand)
  7522. {
  7523. while(next_control<=ignore_defn)
  7524. {/* Skip \TeX\ stuff, \.{@f}, \.{@l}, \.{@v}, and \.{@W}. */
  7525. if((next_control= 
  7526. skip_ahead(next_control,YES))==module_name)
  7527. {/* scan the module name too */
  7528. loc-= 2;next_control= get_next();
  7529. }
  7530. }
  7531. scanning_TeX= NO;
  7532. }
  7533. else /* Process incoming code text. */
  7534. if(!expand)
  7535. {
  7536. while((next_control= 
  7537. skip_ahead(next_control,YES))==module_name)
  7538. if((next_control= skip_ahead(next_control,YES))!=ignore)
  7539.  
  7540. err0_print(ERR_T,OC("Expected @> after @<"),0);
  7541. }
  7542. else
  7543. {/* Process another complete fragment of code. */
  7544.  
  7545. {
  7546. store_two_bytes((sixteen_bits)(LINE_NUM+module_count));
  7547. }
  7548.  
  7549.  
  7550. scan_repl(module_name,stop_the_scan);/* Now |cur_text| \
  7551. points to the replacement text. */
  7552.  
  7553. {
  7554. if(p==name_dir||p==NULL)
  7555. {/* Unnamed module, or bad module name */
  7556. cur_text->module_text= (first_text&&mlevel==1);
  7557.  
  7558. /* The unnamed module begins in the global language.  However, subsequent \
  7559. language changes within one section---e.g., by preprocessing---should be \
  7560. retained. */
  7561. if(cur_text->module_text)
  7562. cur_text->Language= (boolean)global_language;
  7563.  
  7564. last_unnamed->text_link= cur_text-text_info;
  7565. /* Link the unnamed module together. */
  7566. last_unnamed= cur_text;/* Present end of the unnamed module. */
  7567. }
  7568. else if(p->equiv==(EQUIV)text_info)
  7569. {/* First module of this name. */
  7570. cur_text->module_text= YES;
  7571. p->equiv= (EQUIV)cur_text;
  7572. }
  7573. else
  7574. {/* Link on the |cur_text| to the linked list. */
  7575. LANGUAGE language0;
  7576.  
  7577. q= (text_pointer)p->equiv;/* Start of the chain. */
  7578. language0= (LANGUAGE)q->Language;/* Global language of this module. */
  7579.  
  7580. /* Each replacement text (for a module name) has the same language as the \
  7581. first in the chain.  Thus language switching works very efficiently; \
  7582. modules inherit the language of their superior.  On the other hand, \
  7583. preprocessor fragments should retain the current language, as should the \
  7584. fragment following a preprocessor fragment. */
  7585. cur_text->module_text= (first_text&&mlevel==1);
  7586.  
  7587. if(cur_text->module_text)
  7588. cur_text->Language= (boolean)language0;
  7589.  
  7590. /* Find end of list, delimited by |module_flag|.  (There's nothing \
  7591. comparable to |last_unnamed| to tell us where the end is.) */
  7592. while(q->text_link<module_flag)q= q->text_link+text_info;
  7593.  
  7594. q->text_link= cur_text-text_info;
  7595. /* Append more stuff to this module by linking in |cur_text|. */
  7596. }
  7597.  
  7598. /* |cur_text| has now been linked to the end of the appropriate chain.  Use \
  7599. |module_flag| as a special |text_link| to signify the end of the list. */
  7600. cur_text->text_link= module_flag;
  7601. }
  7602.  
  7603.  
  7604. first_text= NO;
  7605. }
  7606.  
  7607. next_macro_token:
  7608. switch(next_control)
  7609. {
  7610.  
  7611.  
  7612. case m_ifdef:
  7613. DEF_OR_NDEF(M_TRUE);
  7614. break;
  7615.  
  7616. case m_ifndef:
  7617. DEF_OR_NDEF(M_FALSE);
  7618. break;
  7619.  
  7620. case m_if:
  7621. found_else= NO;
  7622.  
  7623. if(!expand)
  7624. {
  7625. to_endif(m_if);
  7626. goto next_macro_token;
  7627. }
  7628. else
  7629.  
  7630. {
  7631.  
  7632. {
  7633. boolean scan0= scanning_defn;
  7634.  
  7635. scanning_defn= YES;
  7636. scan_repl(macro,STOP);
  7637. scanning_defn= scan0;
  7638.  
  7639. cur_text->nargs= UNDEFINED_MACRO;
  7640.  
  7641. pp= xmac_text(macrobuf,cur_text->tok_start,tok_ptr);/* See \.{macs.web}. */
  7642. if_switch= eval(pp,mp);/* See \.{eval.web}. */
  7643. }
  7644.  
  7645. ;
  7646. GET_LINE;/* Skip possible comment at end of \.{@\#if}. */
  7647.  
  7648. if(if_switch)
  7649. scan_text(text_type,p,if_switch);
  7650. else
  7651.  
  7652. {
  7653. expand= NO;to_else();
  7654.  
  7655. if(next_control!=m_endif)
  7656. {
  7657. scanned_if= YES;
  7658. goto next_macro_token;
  7659. }
  7660. else
  7661. {
  7662. next_control= ignore;
  7663. expand= YES;
  7664. GET_LINE;/* Skip possible comment after \.{@\#endif} */
  7665. break;
  7666. }
  7667. }
  7668.  
  7669.  
  7670. }
  7671.  
  7672.  
  7673.  
  7674. break;
  7675.  
  7676. case m_elif:
  7677. /* The |elif| is essentially the inverse of |if|. If we were in the midst \
  7678. of an expansion, everything else must be skipped until |endif|. This is \
  7679. done via |to_endif|; we must process the |endif| again in order to return \
  7680. properly from the recursive scan in progress.  If we were not in the midst \
  7681. of an expansion, we got here via a |to_else|; we must now proceed just as \
  7682. though this were an |if|. */
  7683. next_control= ignore;
  7684.  
  7685. if((mlevel==1&&!scanned_if)||found_else)
  7686. {
  7687. OUT_OF_ORDER("elif");
  7688. break;
  7689. }
  7690.  
  7691. scanned_if= NO;
  7692.  
  7693. if(expand)
  7694. {
  7695. to_endif(m_elif);
  7696. goto next_macro_token;
  7697. }
  7698. else
  7699.  
  7700. {
  7701.  
  7702. {
  7703. boolean scan0= scanning_defn;
  7704.  
  7705. scanning_defn= YES;
  7706. scan_repl(macro,STOP);
  7707. scanning_defn= scan0;
  7708.  
  7709. cur_text->nargs= UNDEFINED_MACRO;
  7710.  
  7711. pp= xmac_text(macrobuf,cur_text->tok_start,tok_ptr);/* See \.{macs.web}. */
  7712. if_switch= eval(pp,mp);/* See \.{eval.web}. */
  7713. }
  7714.  
  7715. ;
  7716. GET_LINE;/* Skip possible comment at end of \.{@\#if}. */
  7717.  
  7718. if(if_switch)
  7719. scan_text(text_type,p,if_switch);
  7720. else
  7721.  
  7722. {
  7723. expand= NO;to_else();
  7724.  
  7725. if(next_control!=m_endif)
  7726. {
  7727. scanned_if= YES;
  7728. goto next_macro_token;
  7729. }
  7730. else
  7731. {
  7732. next_control= ignore;
  7733. expand= YES;
  7734. GET_LINE;/* Skip possible comment after \.{@\#endif} */
  7735. break;
  7736. }
  7737. }
  7738.  
  7739.  
  7740. }
  7741.  
  7742.  
  7743.  
  7744. expand= YES;
  7745. break;
  7746.  
  7747. case m_else:
  7748. /* When processing an |else|, we take action based on the opposite of the \
  7749. |expand| flag currently in effect. If |expand == YES|, we must then skip \
  7750. everything else until the |endif|. This is done with |to_end|; we must \
  7751. process the |endif| again in order to return properly from the recursion in \
  7752. progress when we got here.  If |expand == NO|, we got here via a |to_else|; \
  7753. we must now expand everything until the |endif|. */
  7754. next_control= ignore;
  7755.  
  7756. if((mlevel==1&&!scanned_if)||found_else)
  7757. {
  7758. OUT_OF_ORDER("else");
  7759. break;
  7760. }
  7761.  
  7762. found_else= YES;
  7763. scanned_if= NO;
  7764.  
  7765. expand= BOOLEAN(!expand);
  7766.  
  7767. GET_LINE;/* Skip possible comment after \.{@\#else}. */
  7768.  
  7769. if(expand)
  7770. scan_text(text_type,p,expand);
  7771. else
  7772. {
  7773. to_endif(m_else);
  7774. expand= YES;
  7775. goto next_macro_token;
  7776. }
  7777.  
  7778. break;
  7779.  
  7780. case m_endif:
  7781. next_control= ignore;
  7782.  
  7783. if(mlevel==1)
  7784. {
  7785. OUT_OF_ORDER("endif");
  7786. break;
  7787. }
  7788.  
  7789. found_else= NO;
  7790. GET_LINE;/* Skip possible comment after \.{@\#endif}. */
  7791. mlevel--;
  7792. return;/* Ends recursion on |scan_text|. */
  7793.  
  7794. case m_undef:
  7795. if(!expand)
  7796. next_control= ignore;
  7797. else
  7798. {
  7799. if((next_control= get_next())!=identifier)
  7800.  
  7801. err0_print(ERR_M,OC("Identifier must follow @#undef"),0);
  7802. else
  7803. {
  7804. undef(ID_NUM(id_first,id_loc),COMPLAIN);
  7805. GET_LINE;/* Skip possible comment at end of \
  7806. \.{@\#undef}. */
  7807. }
  7808. }
  7809. break;
  7810.  
  7811. case m_for:
  7812. case m_endfor:
  7813. case m_pragma:
  7814. if(!expand)next_control= ignore;
  7815. else
  7816. {
  7817.  
  7818. err0_print(ERR_M,OC("Sorry, preprocessor command isn't implemented yet"),0);
  7819. }
  7820. break;
  7821.  
  7822.  
  7823.  
  7824. case new_output_file:
  7825.  
  7826. err0_print(ERR_T,OC("@O and @o are allowed only in the code \
  7827. section; command ignored"),0);
  7828. next_control= ignore;
  7829. loc= limit+1;
  7830. break;
  7831.  
  7832. case definition:case undefinition:
  7833. case WEB_definition:
  7834. if(!expand)
  7835. next_control= ignore;
  7836. else
  7837. {
  7838. name_pointer np;
  7839. eight_bits last_control;
  7840.  
  7841. if((np= app_macro(last_control= next_control))
  7842. ==NULL)continue;
  7843. else if(last_control==WEB_definition)
  7844. np->equiv= (EQUIV)cur_text;
  7845. }
  7846. break;
  7847.  
  7848.  
  7849. default:
  7850. if(next_control<=ignore_defn)
  7851. break;
  7852.  
  7853. mlevel--;
  7854. return;
  7855. }
  7856. }
  7857. }
  7858.  
  7859.  
  7860.  
  7861. SRTN out_of_order FCN((cmd))
  7862. CONST outer_char cmd[]C1("Name of bad preprocessor command.")
  7863. {
  7864.  
  7865. err0_print(ERR_M,OC("Ignored out-of-order \"@#%s\" (mlevel = %d)"),2,cmd,mlevel);
  7866. }
  7867.  
  7868.  
  7869.  
  7870. SRTN to_else(VOID)
  7871. {
  7872. int elevel= 0,elifs[MAX_LEVEL],elses[MAX_LEVEL],k;
  7873.  
  7874. for(k= 0;k<MAX_LEVEL;k++)
  7875. elifs[k]= elses[k]= 0;
  7876.  
  7877. WHILE()
  7878. switch(next_control= skip_ahead(next_control,NO))
  7879. {
  7880. case m_if:
  7881. case m_ifdef:
  7882. case m_ifndef:
  7883. elevel++;
  7884. break;
  7885.  
  7886. case m_elif:
  7887. if(elses[elevel])
  7888.  
  7889. err0_print(ERR_M,OC("Can't have @#elif after @#else"),0);
  7890. elifs[elevel]++;
  7891. if(elevel==0)return;
  7892. break;
  7893.  
  7894. case m_else:
  7895. if(elses[elevel]++)
  7896.  
  7897. err0_print(ERR_M,OC("Only one @#else allowed \
  7898. (scanning to @else)"),0);
  7899. if(elevel==0)
  7900. {
  7901. if(language==TEX&&!get_line())
  7902. loc= limit+1;
  7903. return;
  7904. }
  7905. break;
  7906.  
  7907. case m_endif:
  7908.  
  7909. elifs[elevel]= elses[elevel]= 0;
  7910.  
  7911. if(elevel--==0)
  7912. {
  7913. found_else= NO;
  7914. if(language==TEX&&!get_line())
  7915. loc= limit+1;
  7916. return;
  7917. }
  7918. break;
  7919.  
  7920. case new_module:
  7921.  
  7922. err0_print(ERR_M,OC("Section ended during scan for \
  7923. \"@#else\", \"@#elif\", or \"@#endif\". Inserted \"@#endif\". \
  7924. (elevel = %d)"),1,elevel);
  7925. if(elevel==0)
  7926. found_else= NO;
  7927.  
  7928. return;/* The |new_module| is turned into an |m_endif|. */
  7929. }
  7930. }
  7931.  
  7932.  
  7933.  
  7934. SRTN to_endif FCN((m_case))
  7935. int m_case C1("Case that called to_endif")
  7936. {
  7937. int elevel= 1,elifs[MAX_LEVEL],elses[MAX_LEVEL],k;
  7938.  
  7939. for(k= 0;k<MAX_LEVEL;k++)
  7940. elifs[k]= elses[k]= 0;
  7941.  
  7942. if(m_case==m_elif)
  7943. elifs[elevel]= 1;
  7944. else
  7945. {
  7946. if(m_case==m_else)
  7947. elses[elevel]= 1;
  7948. }
  7949.  
  7950. WHILE()
  7951. switch(next_control= skip_ahead(next_control,NO))
  7952. {
  7953. case m_if:
  7954. case m_ifdef:
  7955. case m_ifndef:
  7956. elevel++;
  7957. break;
  7958.  
  7959. case m_elif:
  7960. if(elses[elevel])
  7961.  
  7962. err0_print(ERR_M,OC("Can't have @#elif after @#else"),0);
  7963. elifs[elevel]++;
  7964. break;
  7965.  
  7966. case m_else:
  7967. if(elses[elevel]++)
  7968.  
  7969. err0_print(ERR_M,OC("Only one @#else allowed \
  7970. (scanning to @endif)"),0);
  7971. break;
  7972.  
  7973. case m_endif:
  7974.  
  7975. elifs[elevel]= elses[elevel]= 0;
  7976.  
  7977. if(--elevel==0)
  7978. {
  7979. found_else= NO;
  7980. if(language==TEX&&!get_line())
  7981. loc= limit+1;
  7982. return;
  7983. }
  7984. break;
  7985.  
  7986. case new_module:
  7987.  
  7988. err0_print(ERR_M,OC("Section ended during scan for \
  7989. \"endif\"; inserted \"endif\". (elevel = %d)"),1,elevel);
  7990. if(elevel==0)
  7991. found_else= NO;
  7992. return;
  7993. }
  7994. }
  7995.  
  7996.  
  7997.  
  7998. name_pointer app_macro FCN((last_control))
  7999. eight_bits last_control C1("Last token processed.")
  8000. {
  8001. sixteen_bits a;
  8002. name_pointer np= NULL;
  8003. boolean make_recursive= NO;
  8004. ASCII insert_type[6];
  8005. int insert_num= 0;
  8006. eight_bits temp[2];/* Holds the macro identifier. */
  8007. boolean nuweb_mode0= nuweb_mode;
  8008.  
  8009. nuweb_mode= NO;/* Don't parse the beginning of macro defn's literally. */
  8010.  
  8011. is_WEB_macro= BOOLEAN(last_control==WEB_definition);
  8012.  
  8013. if(is_WEB_macro||C_LIKE(language))
  8014. {
  8015. while((next_control= get_next())==012)
  8016. ;/* Allow definition to start on  next line. */
  8017.  
  8018. if(is_WEB_macro)
  8019. if(next_control==MAKE_RECURSIVE)
  8020. {
  8021. make_recursive= YES;
  8022. next_control= get_next();
  8023. }
  8024. else if(next_control==AUTO_INSERT)
  8025.  
  8026. {
  8027. ASCII c;
  8028.  
  8029. while((c= *loc++)!=END_AUTO_INSERT)
  8030. {
  8031. if(*loc==040)
  8032. {
  8033.  
  8034. err0_print(ERR_M,OC("Found space instead of ']' after automatic \
  8035. insertion material"),0);
  8036. break;
  8037. }
  8038.  
  8039. if(loc==limit)break;
  8040.  
  8041. if(insert_num>=6)
  8042. {
  8043. if(insert_num++==6)
  8044.  
  8045. err0_print(ERR_M,OC("Can't have more than 6 types of automatic \
  8046. insertion material; remaining ignored"),0);
  8047. continue;
  8048. }
  8049.  
  8050. switch(c)
  8051. {
  8052. case 052:
  8053. STRNCPY(insert_type,"pmsfbi",insert_num= 6);
  8054. break;
  8055.  
  8056. case 0160:case 0120:
  8057. case 0155:case 0115:
  8058. case 0163:case 0123:
  8059. case 0146:case 0106:
  8060. case 0142:case 0102:
  8061. case 0151:case 0111:
  8062. insert_type[insert_num++]= c;
  8063. break;
  8064.  
  8065. default:
  8066.  
  8067. err0_print(ERR_M,OC("Auto insertion type must be one of \
  8068. \"ibfmps\""),0);
  8069. continue;
  8070. }
  8071. }
  8072.  
  8073. next_control= get_next();
  8074. }
  8075.  
  8076.  
  8077.  
  8078. if(next_control!=identifier)
  8079. {
  8080.  
  8081. err0_print(ERR_M,OC("Definition flushed in %s; must start with \
  8082. identifier"),1,MTRANS);
  8083.  
  8084. np= NULL;
  8085. goto done_append;
  8086. }
  8087.  
  8088. a= ID_NUM_ptr(np,id_first,id_loc);/* The identifier. */
  8089.  
  8090. /* Process auto insertion. */
  8091. temp[0]= LEFT(a,ID0);temp[1]= RIGHT(a);
  8092.  
  8093. {
  8094. while(insert_num-->0)
  8095. switch(insert_type[insert_num])
  8096. {
  8097. case 0160:case 0120:
  8098. if(insert.program.end>insert.program.start)
  8099.  
  8100. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"program");
  8101. STRNCPY(insert.program.start,temp,2);
  8102. insert.program.end= insert.program.start+2;
  8103. break;
  8104.  
  8105. case 0155:case 0115:
  8106. if(insert.module.end>insert.module.start)
  8107.  
  8108. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"module");
  8109. STRNCPY(insert.module.start,temp,2);
  8110. insert.module.end= insert.module.start+2;
  8111. break;
  8112.  
  8113. case 0163:case 0123:
  8114. if(insert.subroutine.end>insert.subroutine.start)
  8115.  
  8116. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"subroutine");
  8117. STRNCPY(insert.subroutine.start,temp,2);
  8118. insert.subroutine.end= insert.subroutine.start+2;
  8119. break;
  8120.  
  8121. case 0146:case 0106:
  8122. if(insert.function.end>insert.function.start)
  8123.  
  8124. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"function");
  8125. STRNCPY(insert.function.start,temp,2);
  8126. insert.function.end= insert.function.start+2;
  8127. break;
  8128.  
  8129. case 0142:case 0102:
  8130. if(insert.blockdata.end>insert.blockdata.start)
  8131.  
  8132. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"blockdata");
  8133. STRNCPY(insert.blockdata.start,temp,2);
  8134. insert.blockdata.end= insert.blockdata.start+2;
  8135. break;
  8136.  
  8137. case 0151:case 0111:
  8138. if(insert.interface.end>insert.interface.start)
  8139.  
  8140. err0_print(ERR_M,OC("Overriding previous auto insertion type %s"),1,"interface");
  8141. STRNCPY(insert.interface.start,temp,2);
  8142. insert.interface.end= insert.interface.start+2;
  8143. break;
  8144. }
  8145. }
  8146.  
  8147.  
  8148.  
  8149. /* Append the lhs. */
  8150. app_repl(temp[0]);
  8151. app_repl(temp[1]);
  8152.  
  8153. np->macro_type= IMMEDIATE_MACRO;
  8154. /* Mark this name as a macro. |macro_type| isn't otherwise used by \Tangle. */
  8155.  
  8156. if(*loc!=050)
  8157. {
  8158. if(is_WEB_macro)
  8159. {app_repl(040);}
  8160. else if(C_LIKE(language))
  8161. {/* For outer macros, identifier must be separated \
  8162. from replacement text */
  8163. app_repl(stringg);app_repl(040);app_repl(stringg);
  8164. }
  8165. }
  8166. }
  8167.  
  8168. nuweb_mode= nuweb_mode0;
  8169. scan_repl((eight_bits)macro,(boolean)(!scanning_defn));/* Copy stuff \
  8170.             verbatim. (Also sets the language.) */
  8171.  
  8172. /* Finish off storing the macro. */
  8173. if(is_WEB_macro)
  8174.  
  8175. {
  8176. text_ptr->tok_start= tok_ptr= argize(cur_text->tok_start,tok_ptr);/* Set \
  8177.     new end by possibly stripping off newlines. */
  8178. cur_text->Language= (boolean)global_language;/* This value shouldn't matter. */
  8179. cur_text->recursive= make_recursive;
  8180. }
  8181.  
  8182.  
  8183. else
  8184. cur_text->nargs= (eight_bits)CHOICE(last_control==definition,
  8185. OUTER_MACRO,OUTER_UNMACRO);/* Mark the outer macros. */
  8186.  
  8187. cur_text->text_link= macro;/* |text_link=0| characterizes a macro. */
  8188.  
  8189. done_append:
  8190. is_WEB_macro= NO;/* Reset. */
  8191. return np;
  8192. }
  8193.  
  8194.  
  8195.  
  8196. SRTN app_dmacro FCN((p,p1))
  8197. CONST eight_bits HUGE*p C0("Start")
  8198. CONST eight_bits HUGE*p1 C1("End.")
  8199. {
  8200. eight_bits a0,a1;
  8201. sixteen_bits a;
  8202. name_pointer np;
  8203. boolean make_recursive= NO;
  8204.  
  8205. if(*p==MAKE_RECURSIVE)
  8206. {
  8207. make_recursive= YES;
  8208. p++;
  8209. }
  8210.  
  8211. if(p+2>p1)
  8212. {
  8213.  
  8214. macro_err(OC("Invalid argument to $DEFINE"),YES);
  8215. return;
  8216. }
  8217.  
  8218. if(TOKEN1(a0= *p++))
  8219. {
  8220.  
  8221. macro_err(OC("$DEFINE flushed; must start with identifier"),YES);
  8222. return;
  8223. }
  8224.  
  8225. a= IDENTIFIER(a0,a1= *p++);
  8226. app_repl(a0);
  8227. app_repl(a1);
  8228.  
  8229. np= name_dir+a;
  8230.  
  8231. np->macro_type= IMMEDIATE_MACRO;
  8232.  
  8233. if(*p==075){p++;app_repl(040);}/* Allow for zero-argument macro. */
  8234.  
  8235. while(p<p1){app_repl(*p++);}
  8236.  
  8237.  
  8238. {
  8239. if(text_ptr>text_end)OVERFLW("texts","x");
  8240. cur_text= text_ptr;
  8241. (++text_ptr)->tok_start= tok_ptr;/* The next start is the present end. */
  8242. }
  8243.  
  8244. ;
  8245.  
  8246. {
  8247. text_ptr->tok_start= tok_ptr= argize(cur_text->tok_start,tok_ptr);/* Set \
  8248.     new end by possibly stripping off newlines. */
  8249. cur_text->Language= (boolean)global_language;/* This value shouldn't matter. */
  8250. cur_text->recursive= make_recursive;
  8251. }
  8252.  
  8253. ;
  8254. cur_text->text_link= macro;
  8255. np->equiv= (EQUIV)cur_text;
  8256. }
  8257.  
  8258.  
  8259.  
  8260. SRTN i_define_ FCN((n,pargs))
  8261. int n C0("")
  8262. PARGS pargs C1("")
  8263. {
  8264. CHK_ARGS("$M",1);
  8265.  
  8266. app_dmacro(pargs[0]+1,pargs[1]);
  8267. }
  8268.  
  8269.  
  8270.  
  8271. SRTN i_undef_ FCN((n,pargs))
  8272. int n C0("")
  8273. PARGS pargs C1("")
  8274. {
  8275. eight_bits a0;
  8276. eight_bits HUGE*p= pargs[0]+1;
  8277.  
  8278. CHK_ARGS("$UNDEF",1);
  8279.  
  8280. if(p+2>pargs[1])
  8281. {
  8282.  
  8283. macro_err(OC("Invalid argument to $UNDEF"),YES);
  8284. return;
  8285. }
  8286.  
  8287. if(TOKEN1(a0= *p++))
  8288. {
  8289.  
  8290. macro_err(OC("$UNDEF flushed; must start with identifier"),YES);
  8291. return;
  8292. }
  8293.  
  8294. undef(IDENTIFIER(a0,*p),COMPLAIN);
  8295. }
  8296.  
  8297.  
  8298.  
  8299. SRTN phase1(VOID)
  8300. {
  8301. LANGUAGE language0= language;
  8302.  
  8303. phase= 1;
  8304. module_count= 0;
  8305. rst_input();rst_out(NOT_CONTINUATION);
  8306. reading(web_file_name,NO);
  8307.  
  8308. while((next_control= skip_ahead(ignore,NO))!=new_module)
  8309. ;/* Skip stuff before first module.  This may reset the language. */
  8310.  
  8311. chk_override(language0);
  8312. fin_language();/* Make sure flags are initialized properly. */
  8313. global_params= params;/* Remember the global parameters. */
  8314. set_output_file(global_language);/* Language in force at the \
  8315.                 beginning of each module. */
  8316.  
  8317. while(!input_has_ended)
  8318. scan_module();/* Do each module one at a time. */
  8319.  
  8320. chk_complete();/* Anything left in change file? */
  8321.  
  8322. {
  8323. name_pointer np;
  8324.  
  8325.  
  8326. for(np= name_dir;np<name_ptr;np++)
  8327. if(np->equiv!=NULL&&np->equiv!=(EQUIV)text_info
  8328. &&np->macro_type==NOT_DEFINED)
  8329. num_distinct_modules++;
  8330.  
  8331. num_modules= module_count;
  8332. }
  8333.  
  8334.  
  8335. }
  8336.  
  8337.  
  8338.  
  8339. SRTN i_modules_ FCN((n,pargs))
  8340. int n C0("")
  8341. PARGS pargs C1("")
  8342. {
  8343. outer_char temp[50];
  8344. int m= 
  8345. nsprintf(temp,OC("%c%u%c"),3,XCHR(constant),*(pargs[0]+2)=='0'?num_distinct_modules:num_modules,XCHR(constant));
  8346.  
  8347. CHK_ARGS("$MODULES",1);
  8348.  
  8349. MCHECK(m,"_modules_");
  8350. STRCPY(mp,to_ASCII(temp));
  8351. mp+= m;
  8352. }
  8353.  
  8354.  
  8355.  
  8356. SRTN see_tstatistics(VOID)
  8357. {
  8358. CLR_PRINTF(info,("\n\nMEMORY USAGE STATISTICS:\n"));
  8359. STAT0("names",sizeof(*name_ptr),
  8360. SUB_PTRS(name_ptr,name_dir),max_names,smin0(MAX_VAL("n")),"n",",");
  8361.  
  8362. STAT0("replacement texts",sizeof(*text_ptr),
  8363. SUB_PTRS(text_ptr,text_info),max_texts,smin0(MAX_VAL("x")),"x",",");
  8364.  
  8365. STAT0("deferred texts",sizeof(*txt_dptr),
  8366. SUB_PTRS(txt_dptr,txt_dinfo),dtexts_max,smin0(MAX_VAL("dx")),"dx",";");
  8367.  
  8368. STAT0("bytes",sizeof(*byte_ptr),
  8369. SUB_PTRS(byte_ptr,byte_mem),max_bytes,smin0(MAX_VAL("b")),"b",",");
  8370.  
  8371. STAT0("tokens",sizeof(*tok_ptr),
  8372. SUB_PTRS((mx_tok_ptr>tok_ptr?mx_tok_ptr:tok_ptr),tok_mem),
  8373. max_toks,smin0(MAX_VAL("tt")),"tt",",");
  8374.  
  8375. STAT0("deferred tokens",sizeof(*tok_dptr),
  8376. SUB_PTRS((mx_dtok_ptr>tok_dptr?mx_dtok_ptr:tok_dptr),tok_dmem),
  8377. max_dtoks,smin0(MAX_VAL("dt")),"dt",".");
  8378.  
  8379. mem_avail(1);/* How much memory left at end of run. */
  8380. }
  8381.  
  8382.  
  8383.  
  8384. SRTN t_macros(VOID)
  8385. {
  8386.  
  8387.  
  8388. SAVE_MACRO("_MODULE_NAME $STRING($$MODULE_NAME)");
  8389. SAVE_MACRO("$MODULE_NAME $STRING($$MODULE_NAME)");
  8390.  
  8391.  
  8392.  
  8393. SAVE_MACRO("_STUB(s)$IFCASE($LANGUAGE_NUM,\
  8394. {missing_mod(#s);},{missing_mod(#s);},\
  8395. call nomod(#s),call nomod(#s),\
  8396. call nomod(#s),call nomod(#s),\
  8397. \\missingmod{s},\
  8398. %nomod(s),%nomod(s))");
  8399.  
  8400. SAVE_MACRO("$STUB(s)$IFCASE($LANGUAGE_NUM,\
  8401. {missing_mod(#s);},{missing_mod(#s);},\
  8402. call nomod(#s),call nomod(#s),\
  8403. call nomod(#s),call nomod(#s),\
  8404. \\missingmod{s},\
  8405. %nomod(s),%nomod(s))");
  8406.  
  8407.  
  8408.  
  8409. SAVE_MACRO("_VERSION $STRING($$VERSION)");
  8410. SAVE_MACRO("$VERSION $STRING($$VERSION)");
  8411.  
  8412.  
  8413.  
  8414. SAVE_MACRO("_DAY $TM(0)");
  8415. SAVE_MACRO("_DATE $TM(1)");
  8416. SAVE_MACRO("_TIME $TM(2)");
  8417.  
  8418. SAVE_MACRO("$DAY $TM(0)");
  8419. SAVE_MACRO("$DATE $TM(1)");
  8420. SAVE_MACRO("$TIME $TM(2)");
  8421.  
  8422. SAVE_MACRO("_TM(i)$STRING($$TM(i))");
  8423. SAVE_MACRO("$TM(i)$STRING($$TM(i))");
  8424.  
  8425.  
  8426.  
  8427.  
  8428.  
  8429.  
  8430. SAVE_MACRO("_A(s)$$ASCII(s)");
  8431. SAVE_MACRO("$A(s)$$ASCII(s)");
  8432.  
  8433. SAVE_MACRO("_ASCII(s)$$ASCII(s)");
  8434. SAVE_MACRO("$ASCII(s)$$ASCII(s)");
  8435.  
  8436.  
  8437.  
  8438. SAVE_MACRO("_DEFINE(defn)$$DEFINE(defn)");
  8439. SAVE_MACRO("$DEFINE(defn)$$DEFINE(defn)");
  8440.  
  8441. SAVE_MACRO("_M(defn)$$DEFINE(defn)");/* Shorthand for above. */
  8442. SAVE_MACRO("$M(defn)$$DEFINE(defn)");/* Shorthand for above. */
  8443.  
  8444.  
  8445.  
  8446. SAVE_MACRO("_UNDEF(id)$$UNDEF(#!id)");
  8447. SAVE_MACRO("$UNDEF(id)$$UNDEF(#!id)");
  8448.  
  8449.  
  8450.  
  8451. SAVE_MACRO("_INCR(N,...)$INCR0(#!N,$EVAL(N+$IFELSE(#0,0,1,#1)))");
  8452. SAVE_MACRO("$INCR(N,...)$INCR0(#!N,$EVAL(N+$IFELSE(#0,0,1,#1)))");
  8453.  
  8454. SAVE_MACRO("_DECR(N,...)$INCR0(#!N,$EVAL(N-$IFELSE(#0,0,1,#1)))");
  8455. SAVE_MACRO("$DECR(N,...)$INCR0(#!N,$EVAL(N-$IFELSE(#0,0,1,#1)))");
  8456.  
  8457. SAVE_MACRO("_INCR0(N,N1)$$DEFINE(#!N N1)");
  8458. SAVE_MACRO("$INCR0(N,N1)$$DEFINE(#!N N1)");
  8459.  
  8460.  
  8461.  
  8462. SAVE_MACRO("_MODULES $$MODULES(0)");
  8463. SAVE_MACRO("$MODULES $$MODULES(0)");
  8464.  
  8465. SAVE_MACRO("_SECTIONS $$MODULES(1)");
  8466. SAVE_MACRO("$SECTIONS $$MODULES(1)");
  8467.  
  8468.  
  8469.  
  8470. SAVE_MACRO("_DO(k,kmin,kmax,...)$UNROLL(k,kmin,kmax,$IFCASE(#0,1,#.))");
  8471. SAVE_MACRO("$DO(k,kmin,kmax,...)$UNROLL(k,kmin,kmax,$IFCASE(#0,1,#.))");
  8472.  
  8473. ;
  8474. }
  8475.  
  8476.  
  8477.  
  8478. SRTN out_msg FCN((msg,msg1))
  8479. CONST ASCII*msg C0("Start of message.")
  8480. CONST ASCII*msg1 C1("See the description below.")
  8481. {
  8482. eight_bits HUGE*temp;
  8483. eight_bits HUGE*mp0= mp,
  8484. HUGE*macrobuf0= macrobuf,HUGE*macrobuf_end0= macrobuf_end;
  8485. char HUGE*new_msg;/* The translated message. */
  8486. boolean nuweb_mode0,in_string0,meta_mode0;
  8487.  
  8488. /* Translate the message, which may contain identifiers, into the |macrobuf|.*/
  8489. mp= macrobuf= temp= GET_MEM("out_msg:temp",MSG_BUF_SIZE,eight_bits);
  8490. macrobuf_end= temp+MSG_BUF_SIZE;
  8491.  
  8492. /* If |msg1 != NULL|, then it denotes the end of the array. If it is \
  8493. |NULL|, we assume it's an ordinary character string and determine the end. */
  8494. if(msg1==NULL)
  8495. msg1= msg+STRLEN(msg);
  8496.  
  8497. new_msg= (char HUGE*)str_to_mb((eight_bits HUGE*)msg,
  8498. (eight_bits HUGE*)msg1,NO);
  8499.  
  8500. /* Ship it out in the form of a meta-comment. */
  8501. spcs_after_cmnt= SPCS_AFTER_CMNT;
  8502.  
  8503. /* We bracket the output message by a standard set of |nuweb_mode|, \
  8504. |meta_mode|, and |in_string| in order that the top, bottom, and prefix \
  8505. fields work correctly. */
  8506. nuweb_mode0= nuweb_mode;
  8507. in_string0= in_string;
  8508. meta_mode0= meta_mode;
  8509.  
  8510. meta_mode= nuweb_mode= NO;
  8511. OUT_CHAR(begin_meta);
  8512. OUT_CHAR(begin_meta);/* Second one turns off |xpn_Ratfor|. */
  8513. while(*new_msg)
  8514. OUT_CHAR(*new_msg++);
  8515. OUT_CHAR(end_meta);
  8516.  
  8517. nuweb_mode= nuweb_mode0;
  8518. in_string= in_string0;
  8519. meta_mode= meta_mode0;
  8520.  
  8521. spcs_after_cmnt= 0;
  8522.  
  8523. FREE_MEM(temp,"out_msg:temp",MSG_BUF_SIZE,eight_bits);
  8524. macrobuf= macrobuf0;mp= mp0;macrobuf_end= macrobuf_end0;
  8525. }
  8526.  
  8527.  
  8528.  
  8529. static sixteen_bits id_unroll;
  8530.  
  8531. SPEC univ_tokens[]= {
  8532. {"_UNROLL",0,x_unroll,&id_unroll},
  8533. {"$UNROLL",0,x_unroll,&id_unroll},
  8534. {"",0,NULL,NULL}
  8535. };
  8536.  
  8537. SRTN ini_univ_tokens FCN((language0))
  8538. LANGUAGE language0 C1("")
  8539. {
  8540. ini_special_tokens(language0,univ_tokens);
  8541. }
  8542.  
  8543.  
  8544.  
  8545. SRTN ini_tokens FCN((language0))
  8546. LANGUAGE language0 C1("")
  8547. {
  8548. switch(language0)
  8549. {
  8550. case C:
  8551. break;
  8552.  
  8553. case C_PLUS_PLUS:
  8554. break;
  8555.  
  8556. case FORTRAN:
  8557. break;
  8558.  
  8559. case FORTRAN_90:
  8560. break;
  8561.  
  8562. case TEX:
  8563. break;
  8564.  
  8565. default:
  8566. break;
  8567. }
  8568.  
  8569. ini_univ_tokens(language0);
  8570. }
  8571.  
  8572.  
  8573.  
  8574. int get_constant FCN((e))
  8575. eight_bits HUGE*e C1("")
  8576. {
  8577. boolean positive= YES;
  8578. int i= 1;/* To prevent the increment from being~0 when an error occurs. */
  8579.  
  8580. if(*e==055)
  8581. {
  8582. positive= NO;
  8583. e++;
  8584. }
  8585.  
  8586. if(*e++!=constant)
  8587. {
  8588.  
  8589. err0_print(ERR_T,OC("Invalid loop constant"),0);
  8590. return i;
  8591. }
  8592.  
  8593. to_outer(e);
  8594. i= ATOI(e);
  8595. return(positive)?i:-i;
  8596. }
  8597.  
  8598.  
  8599.  
  8600.  
  8601. #endif /* |part == 3| */
  8602.  
  8603.  
  8604.