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