home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / fweb153.zip / fweb-1.53 / web / common.c < prev    next >
Text File  |  1995-09-23  |  150KB  |  7,591 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/common -A -# --F -= 1.53/web/common.c" \
  4.   RUN TIME: "Saturday, September 23, 1995 at 16:17." \
  5.   WEB FILE:    "web/common.web" \
  6.   CHANGE FILE: (none)
  7. #endif
  8. #define _COMMON_h  
  9. #define COMMON_FCNS_   \
  10.  
  11. #define VERSION  "1.53"
  12. #define RELEASE  "September 23, 1995" \
  13.  
  14. #define normal  0 /* ordinary identifiers have |normal| ilk */
  15. #define roman  1 /* normal index entries have |roman| ilk */
  16. #define wildcard  2 /* user-formatted index entries have |wildcard| ilk */
  17. #define typewriter  3 /* `typewriter type' entries have |typewriter| ilk */ \
  18.  
  19. #define is_reserved(a)(a->ilk>typewriter)/* tells if a name is a reserved word */ \
  20.  
  21. #define append_xref(c)if(xref_ptr==xmem_end) \
  22. OVERFLW("cross-references","r"); \
  23. else \
  24. { \
  25. (++xref_ptr)->num= c; \
  26. xref_ptr->Language= (boolean)language; \
  27. } \
  28.  
  29. #define def_flag  10240 /* must be strictly larger than |max_modules| */ \
  30.  
  31. #define xref  equiv_or_xref /* The trouble with this is that |xref| is a \
  32.     |xref_pointer| whereas |equiv_or_xref| is |ASCII|. This means that \
  33.     lots of casting needs to be done to keep the compiler happy. Hence \
  34.     the previous |typedef|. */ \
  35.  
  36. #define app(a)*(tok_ptr++)= a /* Ordinary token */
  37. #define APP_ID  app(id_flag+PTR_DIFF(sixteen_bits,id_lookup(id_first,id_loc,normal),name_dir))
  38. #define app1(a)app(tok_flag+PTR_DIFF(sixteen_bits,(a)->trans,tok_start))/* Store translation \
  39.         as token list; should translate to the following: */
  40. #define trans  trans_plus.Trans /* translation texts of scraps */
  41. #define no_math  2
  42. #define yes_math  1
  43. #define maybe_math  0 \
  44.  
  45. #define id_flag  10240 /* Signifies an identifier. */
  46. #define res_flag  2*id_flag /* Signifies a reserved word. */
  47. #define mod_flag  ((sixteen_bits)(3*(sixteen_bits)id_flag)) \
  48. /* Signifies a module name. */
  49. #define tok_flag  ((sixteen_bits)(4*(sixteen_bits)id_flag))/* signifies a token list. */
  50. #define inner_tok_flag  ((sixteen_bits)(5*(sixteen_bits)id_flag)) \
  51. /* Signifies a token list in `\Cb'. */ \
  52.  \
  53.  
  54. #define freeze_text  *(++text_ptr)= tok_ptr \
  55.  
  56. #define cur_end  cur_state.end_field /* Current ending location in |tok_mem|. */
  57. #define cur_byte  cur_state.byte_field /* Location of next output byte in |tok_mem|. */
  58. #define cur_name  cur_state.name_field /* Pointer to current name being expanded. */
  59. #define cur_repl  cur_state.repl_field /* Pointer to current replacement text. */
  60. #define cur_mod  cur_state.mod_field /* Current module number being expanded. */ \
  61.  
  62. #define cur_language  cur_state.language /* Current language. */
  63. #define cur_global_language  cur_state.global_params.Language \
  64. /* Global language for this level. */ \
  65.  \
  66. /* Current flags. */
  67. #define cur_params  cur_state.params /*  Local flags. */
  68. #define cur_global_params  cur_state.global_params /*  Global flags. */ \
  69.  \
  70. /* Current macro buffer params. */
  71. #define macrobuf  cur_state.macro_buf
  72. #define macrobuf_end  cur_state.macro_buf_end \
  73.  
  74. #define STKLEN  20000U /* Borland needs this number; Microsoft requires it from \
  75.             the compiler line. */ \
  76.  
  77. #define first_text_char  0 /* Lowest interesting value of an |outer_char|. */
  78. #define last_text_char  0377 /* Highest interesting value of an |outer_char|. */ \
  79.  
  80. #define TOO_LONG   \
  81. { \
  82. char temp[200]; \
  83. sprintf(temp,"please use the `-ybs...' option to increase buffer size from \
  84. its present value of %lu characters",buf_size); \
  85. FATAL(C,"Input line too long; ",temp); \
  86. } \
  87.  
  88. #define N_WORK  3
  89. #define N_END  (N_WORK+2) \
  90.  
  91. #define is_point(c)(point_comments&&c=='!') \
  92.  
  93. #define MARK(type,delim,len)mark_cmnt(type,delim,len,p) \
  94.  
  95. #define BLANK_OUT(d)MEMSET((d)->pos,040,(d)->len) \
  96.  
  97. #define is_C_style_cmnt  (C_style_cmnt= ((short_cmnt= Cpp_comments&&*lp== \
  98. 057&&*(lp+1)==057))||(*lp==057&&*(lp+1)==052)) \
  99.  
  100. #define start_comment  (is_C_style_cmnt||(*lp==(char)begin_comment0) \
  101. ||(*lp==(char)begin_comment1)) \
  102.  
  103. #define start_Rcomment  ((R_style_cmnt= BOOLEAN(*lp==cmnt_char&& \
  104. *(lp+1)!=cmnt_char&&*(lp-1)!=cmnt_char&& \
  105. !(*(lp-1)==0100)))||is_C_style_cmnt) \
  106.  
  107. #define k0  cur0_prms->K0
  108. #define found_at  cur0_prms->Found_at
  109. #define at_line  cur0_prms->At_line \
  110.  
  111. #define LINES_DONT_MATCH  (change_limit-change_buffer!=limit-cur_buffer|| \
  112. STRNCMP(cur_buffer,change_buffer,PTR_DIFF(size_t,limit,cur_buffer))) \
  113.  
  114. #define change_params  prms[incl_depth].input_params \
  115.  
  116. #define ABORT_ON_ERROR  YES
  117. #define DONT_ABORT_ON_ERROR  NO \
  118.  
  119. #define FCLOSE(file_ptr)if(file_ptr!=stdin)fclose(file_ptr);file_ptr= NULL \
  120.  
  121. #define MAX_SIZE_T  ((BUF_SIZE)(size_t)(~(0L)))/* Maximum argument to |calloc|. */ \
  122.  
  123. #define PTR_BASE  "[%p,%p) "/* To style file? */ \
  124.  
  125. #define SHOW_MEM  0 /* Don't display by default. */ \
  126.  
  127. #define BP_MARKER  1 \
  128.  
  129. #define PROPER_END(end) \
  130. end= (np+1)->byte_start; \
  131. if(*end==BP_MARKER&&np!=npmax)end= ((BP*)end)->byte_start \
  132.  
  133. #define MAX_ID_LENGTH  32 /* Truncated identifiers can't be longer than this. */ \
  134.  
  135. #define hash_size  353 /* should be prime */ \
  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 MAX_ERR_BUF  160 \
  244.  
  245. #define WEAVE_LINE0  OC("{\"")
  246. #define TANGLE_LINE0  OC("  COMMAND LINE: \"") \
  247.  
  248. #define WEAVE_LINE1  OC("\"} ")
  249. #define TANGLE_LINE1  OC("\"") \
  250.  
  251. #define ESCAPE_LENGTH  256 \
  252.  
  253. #define MAX_INI_ARGS  100 /* Max \# of arguments in the ini file. */
  254. #define T_SIZE  200 /* Buffer length for |fgets|. */
  255. #define INI_CMNT_CHAR  '%' \
  256.  
  257. #define BEFORE_CHAR  '-'
  258. #define MIDDLE_CHAR  '0'
  259. #define AFTER_CHAR  '&' \
  260.  
  261. #define HOME  OC("HOME")/* The Unix-standard name for the top-level directory. */
  262. #define ENV_INI  OC("FWEB_INI")/* Default root name to use. */
  263. #define ENV_INCLUDES  OC("FWEB_INCLUDES")/* The include path. */ \
  264.  
  265. #define AUX_LEN  200
  266. #define MAX_MOD_NAMES  3 /* No more than this many names in one error message. */ \
  267.  
  268. #define NMOD_TEMP  200 \
  269.  
  270. #define THE_FILE_NAME  (a_file_name?pa:(outer_char HUGE*)"stdin") \
  271.  
  272. #define ARG_BUFFER_SIZE  500
  273. #define COPY_TO_ARG_BUFFER(c)if(pa<arg_buffer_end)*pa++= c; \
  274. else OVERFLW("arg buffer bytes","")
  275. #define MAX_ARGS  100 \
  276.  
  277. #define STARTING_DO_NUM  UL(90000L) \
  278.  
  279. #define NOT(flag)BOOLEAN((!flag)^not) \
  280.  
  281. #define G_RATIO  2.0
  282. #define MIN_G_RATIO  0.0 /* This value definitively turns off the computed |goto|. */ \
  283.  
  284. #define MARGINAL_CASES  5L
  285. #define MIN_MARGINAL_CASES  1 \
  286.  
  287. #define MAX_SPREAD  UL(128L)
  288. #define MIN_MAX_SPREAD  1 \
  289.  
  290. #define SPRM_LEN  1500 \
  291.  
  292. #define LANGUAGE_SEPARATOR  '='/* Separates language from file name. */ \
  293.  
  294. #define DFLT_FNAME_LENGTH  20 \
  295.  
  296. #define UPDATE_TERMINAL  fflush(stdout)/* Empty the terminal output buffer. */ \
  297.  
  298. #define new_line  putchar('\n')
  299. #define putxchar  putchar \
  300.  
  301. #define TIMING_PREC  10 /* Check that |cpu <= wall| by multiplying seconds by \
  302.                 this number, then truncating. */ \
  303.  
  304.  
  305.  
  306.  
  307. #ifndef part
  308. #define part 0 /* Standard value, when the files aren't split. */
  309. #else
  310. #if(part != 1 && part != 2 && part != 3)
  311. #define part 1 /* Should issue error message here. */
  312. #endif
  313. #endif /* |part| */
  314.  
  315.  
  316.  
  317.  
  318. #if(part == 0 || part == 1)
  319. #define part1_or_extern
  320. #define SET1(stuff)  =  stuff
  321. #define TSET1(stuff)  =  stuff
  322. #else
  323. #define part1_or_extern extern
  324. #define SET1(stuff)
  325. #define TSET1(stuff)
  326. #endif
  327.  
  328.  
  329.  
  330.  
  331.  
  332. #include "typedefs.h"
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339. #include "map.h"
  340.  
  341.  
  342.  
  343.  
  344. #ifdef ibmpc /* \.{Machine-dependent}: For initializing the stack size. */
  345. #ifdef borland
  346. extern unsigned _stklen= STKLEN;
  347. #endif
  348. #endif
  349.  
  350.  
  351.  
  352.  
  353. IN_COMMON ASCII xord[last_text_char+1];/* Converts input chars.\ to |ASCII|. */
  354. #ifdef scramble_ASCII
  355. ASCII xxord[last_text_char+1];/* For scrambling. */
  356. #endif
  357. IN_COMMON outer_char xchr[0200];/* Converts output chars.\ from |ASCII|. */
  358.  
  359.  
  360.  
  361. extern DOTS dots0[],mcmds[];/* These are put into \.{typedefs.web} so we can \
  362.                 make use of the various \.{@d}s. */
  363.  
  364.  
  365.  
  366. IN_COMMON BUF_SIZE delta_dots;/* Expand the table in increments of this size. */
  367. IN_COMMON BUF_SIZE ndots;/* The current total size. */
  368. IN_COMMON DOTS HUGE*dots,HUGE*dots_end,HUGE*next_dot;/* The dynamic array. */
  369.  
  370.  
  371.  
  372. IN_COMMON BUF_SIZE buf_size;/* Holds input line. */
  373.  
  374. IN_COMMON ASCII HUGE*loc;
  375. /* Points to the next character to be read from the buffer. */
  376.  
  377. typedef enum{START,END}DELIM_TYPE;
  378. typedef enum{NO_CMNT,SHORT_CMNT,LONG_CMNT}CMNT_TYPE;
  379.  
  380. typedef struct
  381. {
  382. CMNT_TYPE type;
  383. DELIM_TYPE delim;
  384. eight_bits len;/* Length of the delimiter; either~$0$, $1$, or~$2$. */
  385. ASCII HUGE*pos;/* Start of the delimiter. */
  386. }CMNT_DATA;
  387.  
  388. IN_COMMON CMNT_DATA posns[50],HUGE*pcmnt CSET(posns);
  389.  
  390.  
  391.  
  392. IN_COMMON ASCII HUGE*pk;
  393.  
  394.  
  395.  
  396. IN_COMMON ASCII HUGE*lp,HUGE*semi_pos;
  397. IN_COMMON boolean found_text,text,C_style_cmnt,short_cmnt,R_style_cmnt;
  398.  
  399.  
  400.  
  401. IN_COMMON ASCII HUGE*last_pos;
  402. IN_COMMON ASCII cmnt_char;
  403.  
  404.  
  405.  
  406. IN_COMMON sixteen_bits module_count;/* The current module number. */
  407.  
  408. IN_COMMON BUF_SIZE max_modules;/* Greater than the total number of modules. */
  409. IN_COMMON boolean HUGE*chngd_module;/* Dynamic array: Is the module changed? */
  410.  
  411. IN_COMMON boolean prn_where CSET(NO);
  412. /* Tells \.{TANGLE} to print line and file info */
  413. IN_COMMON boolean return_toggle CSET(NO);
  414. /* Switch used for sending back an `\.{@i}' when |toggle_includes| \
  415.     is on. */
  416. IN_COMMON boolean toggling CSET(NO);/* In the middle of a toggle include? */
  417. IN_COMMON boolean popped CSET(NO);/* After popping the stack? */
  418. IN_COMMON boolean no_more_input CSET(NO);
  419. /* Temporary replacement for |input_has_ended|. */
  420.  
  421. IN_COMMON int tracing;/* For debugging \.{WEAVE}. */
  422.  
  423.  
  424.  
  425. /* Ideally, the following numbers should be large enough to handle both \
  426. \FTANGLE\ and \FWEAVE. In the comments, we show some characteristic \
  427. statistics. */
  428.  
  429. /* \.{Machine-dependent:} Machines with limited memory. */
  430. #if SMALL_MEMORY
  431. #define DFLT_BYTES 10000 /* \.{fweave fweave} $\approx$ 23,300. */
  432. #define DFLT_BUF_SIZE 1500
  433. #define DFLT_C_BUF_SIZE 200
  434. #define DFLT_FMT_SIZE 200
  435. #define DFLT_MSG_SIZE 1000
  436. #define DFLT_DELTA_DOTS 20
  437. #define DFLT_MAX_LBLS 20
  438. #define DFLT_LINE_LENGTH 80
  439. #define DFLT_LONGEST_NAME 1000
  440. #define DFLT_MAX_EXPR_CHARS 500
  441. #define DFLT_MAX_IFILES 10
  442. #define DFLT_MAX_INCLUDE_DEPTH 10
  443. #define DFLT_MAX_MARGS 20
  444. #define DFLT_MAX_MODULES 400
  445. #define DFLT_MBUF_SIZE 32767
  446. #define DFLT_MAX_NAMES 1000 /* \.{fweave fweave} $\approx$ 3,300. */
  447. #define DFLT_MAX_REFS 2500 /* \.{fweave ftangle} $\approx$ 5,850. */
  448. #define DFLT_SBUF_LEN 300
  449. #define DFLT_STACK_SIZE_T 50
  450. #define DFLT_STACK_SIZE_W 210 /* \.{fweave fweave} $\approx$ 200. */
  451. #define DFLT_MAX_SCRAPS 1000 /* \.{fweave fweave} $\approx$ 900. */
  452. #define DFLT_MAX_TOKS_T 50000L /* \.{ftangle fweave} $\approx$ 92,000. */
  453. #define DFLT_MAX_TOKS_W 6000 /* \.{fweave fweave} $\approx$ 6,700. */
  454. #define DFLT_MAX_DTOKS 2500
  455. #define DFLT_MAX_TEXTS 2500 /* \.{fweave fweave} $\approx$ 4,500. */
  456. #define DFLT_MAX_DTEXTS 100
  457. #define DFLT_NUM_FILES 15
  458. #define DFLT_OP_ENTRIES 147
  459. #define DFLT_X_BUF_SIZE 80
  460. #else /* Large limits. */
  461. #define DFLT_BYTES 90000L
  462. #define DFLT_BUF_SIZE 1500
  463. #define DFLT_C_BUF_SIZE 255
  464. #define DFLT_FMT_SIZE 500
  465. #define DFLT_MSG_SIZE 2000
  466. #define DFLT_DELTA_DOTS 20
  467. #define DFLT_MAX_LBLS 20
  468. #define DFLT_LINE_LENGTH 80
  469. #define DFLT_LONGEST_NAME 10000
  470. #define DFLT_MAX_EXPR_CHARS 500
  471. #define DFLT_MAX_IFILES 100
  472. #define DFLT_MAX_INCLUDE_DEPTH 10
  473. #define DFLT_MAX_MARGS 20
  474. #define DFLT_MAX_MODULES 2000
  475. #define DFLT_MBUF_SIZE 50000L
  476. #define DFLT_MAX_NAMES 4000
  477. #define DFLT_MAX_REFS 20000
  478. #define DFLT_SBUF_LEN 300
  479. #define DFLT_STACK_SIZE_T 50
  480. #define DFLT_STACK_SIZE_W 400
  481. #define DFLT_MAX_SCRAPS 10000
  482. #define DFLT_MAX_TOKS_T 150000L
  483. #define DFLT_MAX_TOKS_W 25000
  484. #define DFLT_MAX_DTOKS 25000
  485. #define DFLT_MAX_TEXTS 10239
  486. #define DFLT_MAX_DTEXTS 500
  487. #define DFLT_NUM_FILES 15
  488. #define DFLT_OP_ENTRIES 157
  489. #define DFLT_X_BUF_SIZE 80
  490. #endif /* Limited memory. */
  491.  
  492.  
  493.  
  494.  
  495. IN_COMMON name_pointer name_ptr;/* First unused position in |byte_start|. */
  496. IN_COMMON ASCII HUGE*byte_ptr;/* First unused position in |byte_mem|. */
  497.  
  498.  
  499.  
  500. IN_COMMON ASCII HUGE*pformat,HUGE*pdefault,HUGE*pdata,
  501. HUGE*pbp,HUGE*pinclude,HUGE*ppragma,HUGE*pcontains;
  502.  
  503.  
  504.  
  505. IN_COMMON outer_char outp_buf[MAX_OUTPUT_LINE_LENGTH];
  506. /* FORTRAN's output buffer. */
  507. IN_COMMON int nbuf_length CSET(72);
  508.  
  509. IN_COMMON outer_char wbprefix[MAX_FILE_NAME_LENGTH];
  510. /* Possible directory prefix for the web file name. */
  511.  
  512. /* Signifies the end of a directory prefix. */
  513. IN_COMMON outer_char prefix_end_char CSET(PREFIX_END_CHAR);
  514.  
  515. IN_COMMON boolean all_std CSET(NO);/* Do we route all output to |stdout|? */
  516.  
  517.  
  518.  
  519. IN_COMMON STMT_LBL max_stmt CSET(STARTING_DO_NUM);
  520. IN_COMMON int not;/* For the negations of options. */
  521.  
  522.  
  523.  
  524. IN_COMMON double g_ratio CSET(G_RATIO);
  525. IN_COMMON unsigned short marginal_cases CSET(MARGINAL_CASES);
  526. IN_COMMON CASE_TYPE max_spread CSET(MAX_SPREAD);
  527.  
  528.  
  529.  
  530. IN_COMMON CONST char*day[]
  531. #if(part == 0 || part == 1)
  532. = {"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"}
  533. #endif /* |part == 1| */
  534. ;
  535.  
  536. IN_COMMON CONST char*month[]
  537. #if(part == 0 || part == 1)
  538. = {"January","February","March","April","May","June","July",
  539. "August","September","October","November","December"}
  540. #endif /* |part == 1| */
  541. ;
  542.  
  543.  
  544.  
  545. #if TIMING
  546.  
  547. IN_COMMON clock_t clock0;
  548. IN_COMMON TIME_T time0;
  549.  
  550. #if NEW_DIFFTIME
  551. double diff_time FCN((t1,t0))
  552. TIME_T t1 C0("")
  553. TIME_T t0 C1("")
  554. {
  555. #if HAVE_GETTIMEOFDAY
  556. return(double)(t1.tv_sec-t0.tv_sec)
  557. +1.0e-6*(double)(t1.tv_usec-t0.tv_usec);
  558. #else
  559. #if HAVE_SYS_TIMEB_H
  560. return(double)t1.time-(double)t0.time
  561. +1.0e-3*((double)t1.millitm-(double)t0.millitm);/* \
  562. Without the casts, this line didn't work right on the DECstation. I think \
  563. it has to do with the |unsigned short| type of |millitm|; a compiler bug \
  564. with type promotion. */
  565. #else
  566. return t1-t0;
  567. #endif /* |HAVE_SYS_TIMEB_H| */
  568. #endif
  569. }
  570. #endif /* |NEW_DIFFTIME| */
  571.  
  572. #endif /* |TIMING| */
  573.  
  574.  
  575.  
  576.  
  577. typedef struct xref_info0
  578. {
  579. sixteen_bits num;/* module number plus zero or |def_flag| */
  580. struct xref_info0 HUGE*xlink;/* pointer to the previous \
  581.                 cross-reference */
  582. boolean Language;/* Language in force for this module. */
  583. }xref_info;
  584.  
  585. typedef xref_info HUGE*xref_pointer;
  586. typedef ASCII HUGE*XREF_POINTER;/* For assignments like |name_dir->xref = \
  587.                 (XREF_POINTER)xref_ptr|. See the comment \
  588.                 immediately below about~|xref|. */
  589.  
  590.  
  591.  
  592. typedef sixteen_bits Token;
  593. typedef Token HUGE*token_pointer;
  594. typedef token_pointer HUGE*text_pointer;
  595.  
  596.  
  597.  
  598. typedef struct
  599. {
  600. eight_bits cat;/* Category. It would be nice to |enum| this, but \
  601. that would turn it into an |int|, which could be as much as four times \
  602. bigger. */
  603. eight_bits mathness;
  604. union
  605. {
  606. text_pointer Trans;
  607.  
  608.  
  609.  
  610. }trans_plus;
  611. }scrap;
  612.  
  613. typedef scrap HUGE*scrap_pointer;
  614.  
  615.  
  616.  
  617. typedef struct{
  618. eight_bits HUGE*end_field;/* Ending location of replacement text. */
  619. eight_bits HUGE*byte_field;/* Present location within replacement text. */
  620. name_pointer name_field;/* |byte_start| index for text being output. */
  621. text_pointer repl_field;/* |tok_start| index for text being output. */
  622. sixteen_bits mod_field;/* Module number, or zero if not a module. */
  623. PARAMS global_params,params;/* Various flags. */
  624. eight_bits HUGE*macro_buf,HUGE*macro_buf_end;/* Current macro buffer. */
  625. }output_state;
  626.  
  627. typedef output_state HUGE*stack_pointer;
  628.  
  629.  
  630.  
  631. #if(0)
  632. IN_COMMON boolean truncate_ids;/* Truncate identifers? */
  633. IN_COMMON unsigned short tr_max[];/* Truncate to this length. */
  634. IN_COMMON name_pointer npmax;/* |name_ptr - 1|. */
  635. #endif
  636.  
  637. /* Back-pointer structure points back to the original name in |name_dir|. */
  638. typedef struct Bp
  639. {
  640. ASCII c;/* Dummy byte that always remains~|BP_MARKER|. */
  641. LANGUAGE Language;
  642. CONST ASCII HUGE*byte_start,HUGE*byte_end;/* Points to original, \
  643. untruncated name. */
  644. struct Bp HUGE*next;/* Links to next back-pointer structure, in \
  645. case a truncated name came from more than one original name. */
  646. struct Trunc HUGE*Root;
  647. }BP;
  648.  
  649. /* Info about a truncated identifier. */
  650. typedef struct Trunc
  651. {
  652. boolean Language;/* All languages associated with this name. */
  653. size_t num[NUM_LANGUAGES];
  654. /* \# of instances of the truncated name. */
  655. ASCII HUGE*id,HUGE*id_end;/* Truncated variable name. */
  656. BP HUGE*first,HUGE*last;/* First and last back-pointer structures. */
  657. struct Trunc HUGE*next;/* Next structure in truncated chain. */
  658. }TRUNC;
  659.  
  660.  
  661.  
  662. typedef struct
  663. {
  664. outer_char*secno;/* The \LaTeX\ section number. */
  665. sixteen_bits pageno,modno0;
  666. boolean subpage_flag;/* |YES| if more than one section per page. */
  667. }SECT_INFO;
  668.  
  669. IN_COMMON SECT_INFO HUGE*sect_info;
  670.  
  671. IN_COMMON outer_char HUGE*HUGE*mod_names;
  672. IN_COMMON outer_char HUGE*HUGE*next_mod_name,HUGE*HUGE*last_mod_name;
  673.  
  674.  
  675.  
  676.  
  677. IN_COMMON long start_line CSET(1);
  678. /* Must be |long|; a negative value is used as a flag. */
  679. IN_COMMON long end_line CSET(LONG_MAX);
  680.  
  681.  
  682.  
  683. IN_COMMON int stored_line_length;
  684. IN_COMMON ASCII HUGE*stored_line;/* Allocated dynamically. */
  685.  
  686.  
  687.  
  688. IN_COMMON outer_char last_include_file[MAX_FILE_NAME_LENGTH]CSET(""),
  689. this_include_file[MAX_FILE_NAME_LENGTH]CSET("");
  690.  
  691.  
  692.  
  693.  
  694. /* The shorter length here is primarily to keep the stack under control. \
  695. Now that |N_MSGBUF| is used  dynamically, maybe this statement isn't \
  696. necessary. */
  697. #ifdef SMALL_MEMORY
  698. #define N_MSGBUF 2000
  699. #else
  700. #define N_MSGBUF 10000
  701. #endif
  702.  
  703.  
  704.  
  705.  
  706.  
  707. EXTERN boolean change_exists;/* has any module changed? */
  708.  
  709.  
  710.  
  711. #ifndef COMMON_FCNS_
  712. IN_COMMON BUF_SIZE max_modules;/* Size allocated in \.{common.web}. */
  713. #endif
  714.  
  715. EXTERN BUF_SIZE max_refs;
  716. EXTERN xref_info HUGE*xmem;/* contains cross-reference information */
  717. EXTERN xref_pointer xmem_end;
  718.  
  719. EXTERN xref_pointer xref_ptr;/* the largest occupied position in |xmem| */
  720.  
  721. EXTERN sixteen_bits xref_switch,mod_xref_switch;/* either zero or |def_flag|. */
  722. EXTERN boolean defd_switch;/* Set by `\.{@[}'. */
  723. EXTERN NAME_TYPE defd_type SET(NEVER_DEFINED);
  724. EXTERN boolean typd_switch;/* Set by `\.{@]}'. */
  725. EXTERN boolean index_short;/* Set by `\.{@+}'. */
  726.  
  727.  
  728.  
  729. EXTERN long max_toks;/* number of symbols in \cee\ texts being parsed; \
  730.   must be less than |@r 65536 == 2^16|. */
  731. EXTERN Token HUGE*tok_mem;/* Dynamic array of tokens. */
  732. EXTERN token_pointer tok_m_end;/* End of |tok_mem|. */
  733.  
  734. EXTERN long max_texts;/* number of phrases in \cee\ texts being parsed; \
  735.   must be less than |ID_FLAG|. */
  736. EXTERN token_pointer HUGE*tok_start;/* Dynamic directory into |tok_mem|. */
  737. EXTERN text_pointer tok_end;/* End of |tok_start|. */
  738.  
  739. EXTERN token_pointer tok_ptr;/* First unused position in |tok_mem|. */
  740. EXTERN text_pointer text_ptr;/* First unused position in |tok_start|. */
  741.  
  742. EXTERN token_pointer mx_tok_ptr;/* Largest value of |tok_ptr|. */
  743. EXTERN text_pointer mx_text_ptr;/* Largest value of |text_ptr|. */
  744.  
  745.  
  746.  
  747. EXTERN long max_scraps;/* Length of the next array. */
  748. EXTERN scrap HUGE*scrp_info;/* Dynamic memory array for scraps */
  749. EXTERN scrap_pointer scrp_end;/* end of |scrap_info|. */
  750.  
  751. EXTERN scrap_pointer pp;/* current position for reducing productions */
  752. EXTERN scrap_pointer scrp_base;/* beginning of the current scrap sequence */
  753. EXTERN scrap_pointer scrp_ptr;/* ending of the current scrap sequence */
  754. EXTERN scrap_pointer lo_ptr;/* last scrap that has been examined */
  755. EXTERN scrap_pointer hi_ptr;/* first scrap that has not been examined */
  756.  
  757. EXTERN scrap_pointer mx_scr_ptr;/* largest value assumed by |scrap_ptr| */
  758.  
  759.  
  760.  
  761. #ifndef COMMON_FCNS_
  762. IN_COMMON int tracing;/* Can be used to show parsing details. */
  763. #endif
  764.  
  765.  
  766.  
  767. EXTERN output_state cur_state;/* |cur_end|, |cur_byte|, |cur_name|, \
  768.     |cur_repl|, |cur_mod|, |cur_global_language|, and |cur_language|. */
  769.  
  770. EXTERN long stck_size;/* Number of simultaneous levels of macro expansion. */
  771. EXTERN output_state HUGE*stack;/* Dynamic array: Info for non-current levels. */
  772. EXTERN stack_pointer stck_end;/* End of |stack|. */
  773. EXTERN stack_pointer stck_ptr;/* First unused loc.\ in the output state stack. */
  774.  
  775.  
  776.  
  777. IN_COMMON ASCII string_char;
  778. IN_COMMON boolean in_char_string;
  779.  
  780.  
  781.  
  782. IN_COMMON INPUT_PARAMS change_params0
  783. #if(part == 0 || part == 1)
  784. = {FORTRAN,OUTER,NO}
  785. #endif
  786. ;
  787.  
  788.  
  789.  
  790. IN_COMMON BUF_SIZE max_ifiles;
  791. IN_COMMON int num_ifiles;
  792. IN_COMMON outer_char**ifiles;/* Dynamic array of unique include file names. */
  793.  
  794.  
  795.  
  796. #ifndef C_TYPES
  797. #include SFILE(y_type.h)
  798. #endif /* |C_TYPES| */
  799.  
  800.  
  801.  
  802. IN_COMMON BUF_SIZE total_mem CSET(0);
  803. /* Current total dynamically allocated memory. */
  804. IN_COMMON BUF_SIZE max_mem CSET(0);/* The maximum bytes that were allocated. */
  805.  
  806.  
  807.  
  808. IN_COMMON boolean show_mem CSET(SHOW_MEM);
  809. IN_COMMON BUF_SIZE show_size CSET(10000);/* Display for |nbytes >= show_size|. */
  810.  
  811.  
  812.  
  813. IN_COMMON MEM mem[]
  814. #if(part == 0 || part == 1)
  815. = {
  816. {"b",1,
  817. 1000,DFLT_BYTES,ULONG_MAX},/* |"b"|.  |max_bytes|: the \
  818. number of bytes in identifiers, index entries, and module names. */
  819. {"bs",1,
  820. 500,DFLT_BUF_SIZE,2000},/* |"bs"|.  |change_buffer| etc. */
  821. {"cb",1,
  822. 10,DFLT_C_BUF_SIZE,1000},/* |"cb"|. |C_buf_size|: see |C_putc|. */
  823. {"cf",1,
  824. 100,DFLT_FMT_SIZE,UL(65536L)},/* |"cf"|.|cmd_fsize|: see |out_cmd|. */
  825. {"cg",1,
  826. 100,DFLT_MSG_SIZE,UL(65536L)},/* |"cg"|. |cmd_size|: see |out_cmd| */
  827. {"d",sizeof(DOTS),
  828. 20,DFLT_DELTA_DOTS,255},/* |"d"|.  |delta_dots|: Number of \
  829. additional entries to reallocate for |dots| if necessary. */
  830. {"dt",sizeof(eight_bits),
  831. 1000,DFLT_MAX_DTOKS,ULONG_MAX},/* |"dt"|.  |max_dtoks|. */
  832. {"dx",sizeof(text),
  833. 100,DFLT_MAX_DTEXTS,10239},/* |"dx"|.  |dtexts_max|. */
  834. {"id",sizeof(INPUT_PRMS),
  835. 1,DFLT_MAX_INCLUDE_DEPTH,100},/* |"id"|.  |prms| (open files). */
  836. {"if",sizeof(outer_char*),
  837. 1,DFLT_MAX_IFILES,10000},/* |"if"|.  |max_ifiles|. */
  838. {"kt",sizeof(output_state),
  839. 10,DFLT_STACK_SIZE_T,100},/* |"kt"|.  Tangle's |stck_size|. */
  840. {"kw",sizeof(output_state),
  841. 50,DFLT_STACK_SIZE_W,1000},/* |"kw"|.  Weave's |stck_size|. */
  842. {"lb",sizeof(BEGUN),
  843. 5,DFLT_MAX_LBLS,255},/* |"lb"|. |max_lbls|. */
  844. {"ll",1,
  845. 60,DFLT_LINE_LENGTH,255},/* |"ll"|.  |line_length| for \
  846. \FWEAVE's output. */
  847. {"ln",1,
  848. 3*MAX_FILE_NAME_LENGTH,DFLT_LONGEST_NAME,UL(50000L)},
  849. /* |"ln"|.  |longest_name|: module names and strings shouldn't be longer \
  850. than this. */
  851. {"lx",1,
  852. 25,DFLT_MAX_EXPR_CHARS,UL(65536L)},/* |"lx"|.  |max_expr_chars|. */
  853. {"m",sizeof(boolean),
  854. 100,DFLT_MAX_MODULES,10239},/* |"m"|.  |max_modules|: \
  855. larger than the max number of modules. */
  856. {"ma",sizeof(sixteen_bits),
  857. 1,DFLT_MAX_MARGS,255},/* |"ma"|.  |max_margs|. */
  858. {"mb",1,
  859. 5000,DFLT_MBUF_SIZE,UL(65536L)},/* |"mb"|. |mbuf_size|. */
  860. {"n",sizeof(NAME_INFO)+sizeof(name_pointer),
  861. 500,DFLT_MAX_NAMES,10239},/* |"n"|.  |max_names|: \
  862. number of identifiers, strings, module names; must be less than 10240. */
  863. {"nf",sizeof(OPEN_FILE),
  864. 1,DFLT_NUM_FILES,256},/* |"nf"|.  |num_files|. */
  865. {"op",sizeof(OPERATOR),
  866. 142,DFLT_OP_ENTRIES,256},/* |"op"|. \
  867. |op_entries| */
  868. {"r",sizeof(xref_info),
  869. 500,DFLT_MAX_REFS,UL(65536L)},/* |"r"|. |max_refs|: number of \
  870. cross-references; must be less than 65536. */
  871. {"s",sizeof(scrap),
  872. 1000,DFLT_MAX_SCRAPS,ULONG_MAX},/* |"s"|.  |max_scraps|. */
  873. {"sb",sizeof(outer_char),
  874. 100,DFLT_SBUF_LEN,1000},/* |"sb"|.  |sbuf_len|. */
  875. {"tt",sizeof(eight_bits),
  876. 10000,DFLT_MAX_TOKS_T,ULONG_MAX},/* |"tt"|.  Tangle's \
  877. |max_toks|: Total for the entire code; can be big. */
  878. {"tw",sizeof(sixteen_bits),1000,
  879. DFLT_MAX_TOKS_W,UL(65536L)},/* |"tw"|.  Weave's |max_toks|: \
  880. number of symbols in code texts being parsed;  must be less than 65536. */
  881. {"x",sizeof(text),
  882. 500,DFLT_MAX_TEXTS,10239},/* |"x"|.  |max_texts|. */
  883. {"xb",1,
  884. 10,DFLT_X_BUF_SIZE,1000},/* |"xb"|. |X_buf_size|: see |C_putc|. */
  885. {"",0,0,0}
  886. }
  887. #endif /* |part == 1| */
  888. ;
  889.  
  890. IN_COMMON size_t sizeof_mem CSET(sizeof(mem));
  891.  
  892.  
  893.  
  894. IN_COMMON boolean info_option CSET(NO);
  895. IN_COMMON boolean see_rsrvd CSET(NO);
  896. IN_COMMON RSRVD rsrvd
  897. #if(part == 0 || part == 1)
  898. = {NULL,NO,NO,NO}
  899. #endif /* |part == 1| */
  900. ;
  901. IN_COMMON outer_char HUGE*style_args CSET(NULL);
  902. IN_STYLE ASCII HUGE*at_codes;
  903.  
  904.  
  905.  
  906. IN_COMMON CONST char*origin_name[]
  907. #if(part == 0 || part == 1)
  908. = {"","COMMON","FTANGLE","FWEAVE","RATFOR","MACROS","STYLE"}
  909. #endif /* |part == 1| */
  910. ;
  911.  
  912.  
  913.  
  914. IN_COMMON boolean found_web,found_change;/* Have these names been seen? */
  915. IN_COMMON outer_char wbflnm0[MAX_FILE_NAME_LENGTH];
  916. /* The root name of the web file. */
  917.  
  918.  
  919.  
  920. IN_COMMON outer_char
  921. HUGE*ini_args[MAX_INI_ARGS],/* Arguments read from the ini file. */
  922. HUGE*HUGE*new_args,/* The new list of all arguments; allocated \
  923. dynamically. */
  924. HUGE*HUGE*pn;/* Pointer to the current new argument being processed. */
  925. IN_COMMON outer_char HUGE*HUGE*pn0;/* Marks end of ini args. */
  926. IN_COMMON FILE*ini_file CSET(NULL);/* The ini file \.{.fweb}. */
  927.  
  928.  
  929.  
  930. IN_COMMON INCL_PATHS incl;
  931.  
  932.  
  933.  
  934. IN_COMMON outer_char style_file_name[MAX_FILE_NAME_LENGTH]
  935. CSET(STYLE_FILE_NAME);
  936. IN_COMMON boolean renamed_style CSET(NO);
  937.  
  938.  
  939.  
  940. IN_COMMON boolean doing_cmd_line;/* Command line or optional arguments? */
  941. IN_COMMON boolean cmd_prms;/* Stuff from ini file or from command line? */
  942.  
  943.  
  944.  
  945. IN_COMMON ASCII HUGE*fbuffer,HUGE*flimit,HUGE*floc;/* Saved position \
  946.                 of current file. */
  947.  
  948.  
  949.  
  950. IN_COMMON BUF_SIZE starting_memory CSET(ULONG_MAX);
  951. /* Set at first call to |mem_avail|. */
  952.  
  953.  
  954.  
  955. /* For pc's, the file is split into two compilable parts using the \
  956. compiler-line macro |part|, which must equal either~1 or~2. */
  957. #if(part != 2)
  958.  
  959.  
  960. SRTN
  961. common_init(VOID)
  962. {
  963. IN_RATFOR SRTN is_Rat_present PROTO((VOID));
  964. struct tm*t= the_localtime();/* Initialize the time. */
  965.  
  966. #if(TRANSLATE_ASCII || DEBUG_XCHR)
  967. translate_ASCII= YES;/* Force it for the cases that really need it. */
  968. #endif
  969.  
  970. banner();/* Start-up banner. */
  971.  
  972. is_Rat_present();/* Find out if the \Ratfor\ package was linked on. */
  973.  
  974.  
  975. {
  976. STRNCPY(xchr,"                                 !\"#$%&'()*+,-./0123456789\
  977. :;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ",
  978. sizeof(xchr));
  979.  
  980. /* Interesting ``invisible'' things to output. */
  981. xchr[tab_mark]= '\t';
  982. xchr[012]= '\n';
  983.  
  984. /* nothing needs to be done */
  985.  
  986. ;
  987.  
  988. {
  989. int i;/* to invert the correspondence */
  990.  
  991.  
  992. /* Initialize to |ASCII| blanks. */
  993. for(i= first_text_char;i<=last_text_char;i++)
  994. {
  995. xord[i]= 040;
  996. #ifdef scramble_ASCII
  997. xxord[i]= 040;
  998. #endif
  999. }
  1000.  
  1001. /* The |NUL| and |DEL| characters are left alone! */
  1002. for(i= 1;i<0177;i++)
  1003. {
  1004. xord[(eight_bits)XCHR_[i]]= (ASCII)i;
  1005. #ifdef scramble_ASCII
  1006. xxord[(eight_bits)wt_style.xchr[i]]= i;
  1007. #endif
  1008. }
  1009.  
  1010. #ifdef scramble_ASCII
  1011. for(i= 0177;i<=0377;i++)
  1012. xxord[(eight_bits)wt_style.xchr[i]]= i;
  1013. #endif
  1014.  
  1015. #if(DEBUG_XCHR)
  1016. for(i= 0177;i<=0377;i++)
  1017. xord[(eight_bits)XCHR_[i]]= (ASCII)i;
  1018. #endif
  1019. }
  1020.  
  1021. ;
  1022. }
  1023.  
  1024.  
  1025.  
  1026. {
  1027. int k;
  1028.  
  1029. for(k= 0;k<128;k++)
  1030. TeX[k]= TeX_other;
  1031.  
  1032. for(k= 0101;k<=0132;k++)
  1033. TeX[k]= TeX_letter;
  1034.  
  1035. for(k= 0141;k<=0172;k++)
  1036. TeX[k]= TeX_letter;
  1037.  
  1038. TeX[0134]= TeX_escape;
  1039. TeX[0173]= TeX_bgroup;
  1040. TeX[0175]= TeX_egroup;
  1041. TeX[044]= TeX_math_shift;
  1042. TeX[046]= TeX_alignment_tab;
  1043. TeX[012]= TeX_eol;
  1044. TeX[043]= TeX_parameter;
  1045. TeX[0136]= TeX_superscript;
  1046. TeX[0137]= TeX_subscript;
  1047. TeX[0]= TeX_ignored;
  1048. TeX[040]= TeX[tab_mark]= TeX_space;
  1049. TeX[0176]= TeX_active;
  1050. TeX[045]= TeX_comment;
  1051. TeX[0177]= TeX_invalid;
  1052. }
  1053.  
  1054. ;
  1055.  
  1056. {
  1057. ALLOC(INPUT_PRMS,prms,"id",max_include_depth,1);
  1058. }
  1059.  
  1060.  
  1061.  
  1062. hash= GET_MEM("hash",hash_size,name_pointer);
  1063. hash_end= hash+hash_size-1;
  1064.  
  1065. for(h= hash;h<=hash_end;*h++= NULL);
  1066.  
  1067.  
  1068.  
  1069. pformat= x__to_ASCII(OC("format"));
  1070. pdata= x__to_ASCII(OC("data"));
  1071. pdefault= x__to_ASCII(OC("default"));
  1072. pbp= x__to_ASCII(OC("_BP"));
  1073. pinclude= x__to_ASCII(OC("include"));
  1074. ppragma= x__to_ASCII(OC("pragma"));
  1075.  
  1076. conv_bi(incl_likes);
  1077. conv_bi(WEB_incl_likes);
  1078. conv_bi(non_labels);
  1079.  
  1080. conv_dot(dots0);
  1081. conv_dot(mcmds);
  1082.  
  1083.  
  1084.  
  1085.  
  1086. SET_VAL(mbuf_size,"mb");
  1087.  
  1088. ;
  1089. predefine_macros();/* Must be done before parsing the command line, so \
  1090. the user can undefine or override stuff if desired. */
  1091.  
  1092. {
  1093. #define FSET(flag) =  flag
  1094.  
  1095. active_brackets FSET(ACTIVE_BRACKETS);/* Special array handling? */
  1096. all_cmnts_verbatim FSET(ALL_CMNTS_VERBATIM);/* Should \.{TANGLE} copy \
  1097.                     all comments? */
  1098. all_includes FSET(ALL_INCLUDES);/* Cross-reference all include files? */
  1099. auto_app_semi FSET(AUTO_APP_SEMI);/* For \.{WEAVE}, automatically \
  1100. append a pseudo-semi to the end of \.{WEB} macro definitions? */
  1101. auto_line FSET(AUTO_LINE);/* Auto-insert line nums after \.{@\%}? */
  1102.  
  1103. /* Append automatic semicolon? */
  1104. params.Auto_semi[LN(FORTRAN)]= YES;
  1105.  
  1106. params.Auto_semi[LN(FORTRAN_90)]
  1107. = params.Auto_semi[LN(RATFOR)]
  1108. = params.Auto_semi[LN(RATFOR_90)]
  1109. = params.Auto_semi[LN(C)]
  1110. = params.Auto_semi[LN(C_PLUS_PLUS)]
  1111. = params.Auto_semi[LN(LITERAL)]
  1112. = params.Auto_semi[LN(TEX)]
  1113. = NO;
  1114.  
  1115. params.Beeps FSET(BEEPS);
  1116.  
  1117. /* Do we label |do|s and |if|s with the block number? */
  1118. params.Block_nums[LN(C)]
  1119. = params.Block_nums[LN(C_PLUS_PLUS)]
  1120. = params.Block_nums[LN(LITERAL)]
  1121. = params.Block_nums[LN(TEX)]
  1122. = NO;
  1123.  
  1124. params.Block_nums[LN(FORTRAN)]
  1125. = params.Block_nums[LN(FORTRAN_90)]
  1126. = params.Block_nums[LN(RATFOR)]
  1127. = params.Block_nums[LN(RATFOR_90)]
  1128. = BLOCK_NUMS;
  1129.  
  1130. bslash_continued_strings FSET(BSLASH_CONTINUED_STRINGS);/* Do the \
  1131. continuations of strings require a starting backslash? */
  1132. chk_ifelse FSET(CHK_IFELSE);/* Protect parenthesized strings? */
  1133. chk_stmts FSET(CHK_STMTS);/* Check statement syntax in \Ratfor? */
  1134. compare_outfiles FSET(COMPARE_OUTFILES);/* Compare new vs.\ old output. */
  1135. compound_assignments FSET(COMPOUND_ASSIGNMENTS);/* Do we allow things \
  1136.                             like \.{+=}? */
  1137. Cpp FSET(NO);/* Do we recognize \.{C++}? */
  1138.  
  1139. dbg_output FSET(DBG_OUTPUT);/* Print output characters? */
  1140. deferred_macros FSET(DEFERRED_MACROS);/* Allow deferred macros? */
  1141.  
  1142. defn_mask.outer_macros FSET(PRN_OUTER_MACROS);
  1143. defn_mask.formats FSET(PRN_fORMATS);
  1144. defn_mask.Formats FSET(PRN_FORMATS);
  1145. defn_mask.limbo FSET(PRN_LIMBO);
  1146. defn_mask.macros FSET(PRN_MACROS);
  1147. defn_mask.v FSET(PRN_V);
  1148. defn_mask.w FSET(PRN_W);
  1149.  
  1150. dot_constants FSET(DOT_CONSTANTS);/* Recognize dot constants? */
  1151.  
  1152. params.CPP_comments[LN(C)]
  1153. = params.CPP_comments[LN(C_PLUS_PLUS)]
  1154. = params.CPP_comments[LN(LITERAL)]
  1155. = params.CPP_comments[LN(TEX)]
  1156. = CPP_COMMENTS;
  1157.  
  1158. /* For \Fortran\ and \Ratfor, the \.{//}~is preempted for concatenation. \
  1159. Therefore, its use for short comments must be turned on explicitly. */
  1160. params.CPP_comments[LN(FORTRAN)]
  1161. = params.CPP_comments[LN(FORTRAN_90)]
  1162. = params.CPP_comments[LN(RATFOR)]
  1163. = params.CPP_comments[LN(RATFOR_90)]
  1164. = NO;
  1165.  
  1166. Fortran88 FSET(FORTRAN88);/* Turn on stuff for Fortran-88? */
  1167. Fortran_label FSET(FORTRAN_LABEL);/* Label on same line? */
  1168.  
  1169. params.Free_form_input[LN(FORTRAN)]
  1170. = params.Free_form_input[LN(FORTRAN_90)]
  1171. = params.Free_form_input[LN(LITERAL)]
  1172. = params.Free_form_input[LN(TEX)]
  1173. = NO;
  1174. params.Free_form_input[LN(RATFOR)]
  1175. = params.Free_form_input[LN(RATFOR_90)]
  1176. = params.Free_form_input[LN(C)]
  1177. = params.Free_form_input[LN(C_PLUS_PLUS)]
  1178. = YES;
  1179.  
  1180. keep_trailing_comments FSET(KEEP_TRAILING_COMMENTS);/* For \TeX. */
  1181.  
  1182. params.In_escape[LN(FORTRAN)]
  1183. = params.In_escape[LN(FORTRAN_90)]
  1184. = '&';
  1185. params.In_escape[LN(RATFOR)]
  1186. = params.In_escape[LN(RATFOR_90)]
  1187. = params.In_escape[LN(C)]
  1188. = params.In_escape[LN(C_PLUS_PLUS)]
  1189. = params.In_escape[LN(LITERAL)]
  1190. = params.In_escape[LN(TEX)]
  1191. = '\\';
  1192.  
  1193. in_escape FSET(IN_ESCAPE);/* Default continuation character. */
  1194. index_hidden FSET(INDEX_HIDDEN);/* Index skipped includes files. */
  1195. input_macros FSET(INPUT_MACROS);/* Generate the default ``\.{\\input \
  1196.                     fwebmac.tx}'' line? */
  1197. lc_keywords FSET(LC_KEYWORDS);/* Lower-case \Fortran\ keywords? */
  1198. line_info FSET(LINE_INFO);/* Should \FTANGLE\ print out line info? */
  1199. lowercase_tokens FSET(LOWERCASE_TOKENS);/* Output lower-case tokens? */
  1200. m4 FSET(M4_);
  1201. no_xref FSET(NO_XREF);/* Should \.{WEAVE} print an index? */
  1202. number_dos FSET(NUMBER_DOS);
  1203. nuweb_mode FSET(NUWEB_MODE);/* Emulate \.{nuweb}? */
  1204. overload_ops FSET(OVERLOAD_OPS);/* Is operator overloading allowed? */
  1205.  
  1206. params.Point_comments[LN(C)]
  1207. = params.Point_comments[LN(C_PLUS_PLUS)]
  1208. = params.Point_comments[LN(TEX)]
  1209. = params.Point_comments[LN(LITERAL)]
  1210. = NO;
  1211. params.Point_comments[LN(FORTRAN)]
  1212. = params.Point_comments[LN(FORTRAN_90)]
  1213. = params.Point_comments[LN(RATFOR)]
  1214. = params.Point_comments[LN(RATFOR_90)]
  1215. = POINT_COMMENTS;/* Does \.! signify a Fortran comment? */
  1216.  
  1217. prn_contents FSET(PRN_CONTENTS);/* Print the table of contents? */
  1218. prn_index FSET(PRN_INDEX);/* Print the index? */
  1219. prn_input_lines FSET(NO);/* Used in |input_ln| to print out the \
  1220. lines sent back. */
  1221. prn_input_addresses FSET(NO);/* Print out the buffer addresses. */
  1222. prn_modules FSET(PRN_MODULES);/* Print the module list? */
  1223. prn_semis FSET(PRN_SEMIS);/* Print semicolons in \Fortran\ output? */
  1224.  
  1225. quoted_includes FSET(QUOTED_INCLUDES);
  1226. /* Cross-reference quoted include files? */
  1227. Ratfor77 FSET(RATFOR77);/* Expand \Ratfor\ code directly to \
  1228. \Fortran-77? */
  1229. read_iformats FSET(READ_IFORMATS);/* Read include files for formats. */
  1230. params.Reverse_indices[LN(C)]
  1231. = params.Reverse_indices[LN(C_PLUS_PLUS)]
  1232. = params.Reverse_indices[LN(TEX)]
  1233. = params.Reverse_indices[LN(LITERAL)]
  1234. = NO;
  1235. params.Reverse_indices[LN(FORTRAN)]
  1236. = params.Reverse_indices[LN(FORTRAN_90)]
  1237. = params.Reverse_indices[LN(RATFOR)]
  1238. = params.Reverse_indices[LN(RATFOR_90)]
  1239. = REVERSE_INDICES;/* C-style indexing in \Fortran? */
  1240. rmv_files FSET(RMV_FILES);/* Remove temporary files related to \.{-H}? */
  1241.  
  1242. skip_ifiles FSET(SKIP_IFILES);/* \.{-j} --- skip files already included. */
  1243. skip_includes FSET(SKIP_INCLUDES);/* For \.{WEAVE}, don't read in \.{@I} \
  1244.                     commands. (Uppercase '\.{I}' only.) */
  1245. statistics FSET(STATISTICS);/* Print statistics about memory usage? */
  1246. stop_the_scan FSET(YES);/* */
  1247. subscript_fcns FSET(YES);/* Module references on functions? */
  1248. suppress_cmds FSET(YES);/* ??? */
  1249. toggle_includes FSET(TOGGLE_INCLUDES);/* For \.{WEAVE}, read in \
  1250. \.{@I} commands, but don't print them out. */
  1251. top_version FSET(TOP_VERSION);/* Header info at top of output? */
  1252. translate_ASCII FSET(TRANSLATE_ASCII0);/* Do we bother with the \
  1253. |xchr|--|xord| conversions? */
  1254. translate_brackets FSET(TRANSLATE_BRACKETS);/* Do we translate \
  1255. brackets to parentheses in \Fortran? */
  1256. truncate_ids FSET(NO);/* Shorten identifiers? */
  1257. try_extensions FSET(TRY_EXTENSIONS);/* Try various file names. */
  1258. TeX_processor FSET(TEX_PROCESSOR);/* Default \TeX\ processor. */
  1259. xref_unnamed FSET(XREF_UNNAMED);/* Xref unnamed stuff. */
  1260. #undef FSET
  1261.  
  1262. #if(TRANSLATE_ASCII || DEBUG_XCHR)
  1263. translate_ASCII= YES;/* Force it for the cases that really need it. */
  1264. #endif
  1265.  
  1266. /* The following ensures that |ini_language| will work right.  (It \
  1267. references |global_params|. */
  1268. global_params= params;
  1269. }
  1270.  
  1271.  
  1272.  
  1273.  
  1274. {
  1275.  
  1276. {
  1277. int k;
  1278.  
  1279. /* We initialize the \It{local} name list; it's set to global later after \
  1280. everything else is set. */
  1281. new_fname(&tex_fname,NULL,NULL);
  1282. new_fname(&fwebmac,NULL,NULL);
  1283.  
  1284. for(k= 0;k<NUM_LANGUAGES;k++)
  1285. new_fname(params.outp_nm+k,NULL,NULL);
  1286. }
  1287.  
  1288.  
  1289. scan_args();
  1290.  
  1291. /* If there's no \WEB\ file, it must be an info option. */
  1292. if(found_web)
  1293. {
  1294. ini_input_prms(WEB_FILE,(outer_char HUGE*)"",ABORT_ON_ERROR);
  1295. /* Opens both input and change file. */
  1296.  
  1297. {
  1298. outer_char temp1[100],temp2[1000],
  1299. full_web_name[ESCAPE_LENGTH],esc_full_web_name[ESCAPE_LENGTH],
  1300. full_change_name[ESCAPE_LENGTH],esc_full_change_name[ESCAPE_LENGTH];
  1301. int n1,n2;
  1302. BUF_SIZE old_size;
  1303.  
  1304.  
  1305. /* Run time */
  1306. n1= program==tangle?
  1307. nsprintf(temp1,OC("\n  RUN TIME: \"%s, %s at %s.\""),3,the_day(t),the_cdate(t),the_time(t))
  1308. :
  1309. nsprintf(temp1,OC(""),0);
  1310.  
  1311. #if(VMS)
  1312. fgetname(web_file,full_web_name);
  1313. fgetname(change_file,full_change_name);
  1314. #else
  1315. STRCPY(full_web_name,web_file_name);
  1316. STRCPY(full_change_name,change_file_name);
  1317. #endif /* |VMS| */
  1318.  
  1319. esc_file_name(esc_full_web_name,ESCAPE_LENGTH,full_web_name);
  1320. esc_file_name(esc_full_change_name,ESCAPE_LENGTH,full_change_name);
  1321.  
  1322. n2= 
  1323. nsprintf(temp2,OC(program==tangle?
  1324. "\n  WEB FILE:    \"%s\"\n  CHANGE FILE: %c%s%c":
  1325. " {\"%s\"} {%c%s%c} "),4,esc_full_web_name,*esc_full_change_name?'"':'(',*esc_full_change_name?esc_full_change_name:OC("none"),*esc_full_change_name?'"':')');
  1326.  
  1327. old_size= STRLEN(cmd_ln_buf)+1;
  1328. cmd_ln_buf= (outer_char HUGE*)REALLOC(cmd_ln_buf,old_size+n1+n2,old_size);
  1329. STRCAT(cmd_ln_buf,temp1);
  1330. STRCAT(cmd_ln_buf,temp2);
  1331. }
  1332.  
  1333. ;
  1334.  
  1335. if(program==weave)open_tex_file();
  1336. }
  1337.  
  1338. /* In case no explicit language commands are given, either on the command \
  1339. line or in the file, before encountering the first module, pick a default. */
  1340. if(language==NO_LANGUAGE)
  1341. ini_language(XORD(*LANGUAGE_CODE(GLOBAL_LANGUAGE)));
  1342.  
  1343. global_params= params;/* Freeze the params after arguments have been read. */
  1344. }
  1345.  
  1346. ;
  1347.  
  1348. /* The next two have to be done after reading the command line. */
  1349.  
  1350. {
  1351. DOTS HUGE*d;
  1352.  
  1353. ALLOC(DOTS,dots,"d",delta_dots,0);
  1354. ndots= delta_dots;/* Initialize total size. */
  1355. dots_end= dots+ndots;
  1356. next_dot= dots;/* Current pointer. */
  1357.  
  1358. /* Fill the table with the initial values. */
  1359. for(d= dots0;d->len!=0;d++)
  1360. {
  1361. if(dot_code(dots,d->symbol,d->symbol+d->len,d->code)!=d->code)
  1362. CONFUSION("dots allocation","Invalid dot code");
  1363. }
  1364. }
  1365.  
  1366.  
  1367. {
  1368. BUF_SIZE cur_prms_units;
  1369.  
  1370. alloc(OC("id"),&cur_prms_units,0,-1);/* What is current allocation? */
  1371.  
  1372. if(cur_prms_units!=DFLT_MAX_INCLUDE_DEPTH)
  1373. prms= (INPUT_PRMS*)REALLOC(prms,
  1374. (cur_prms_units+1)*sizeof(INPUT_PRMS),
  1375. (DFLT_MAX_INCLUDE_DEPTH+1)*sizeof(INPUT_PRMS));
  1376. }
  1377.  
  1378.  
  1379.  
  1380. ALLOC(boolean,chngd_module,"m",max_modules,0);
  1381.  
  1382.  
  1383. {
  1384. ALLOC(outer_char*,ifiles,"if",max_ifiles,0);
  1385. }
  1386.  
  1387.  
  1388.  
  1389. ALLOC(ASCII,byte_mem,"b",max_bytes,0);/* Characters of names. */
  1390. byte_end= byte_mem+max_bytes-1;/* End of |byte_mem|. */
  1391.  
  1392. ALLOC(NAME_INFO,name_dir,"n",max_names,0);
  1393. /* Information about names. */
  1394. name_end= name_dir+max_names-1;/* End of |name_dir|. */
  1395.  
  1396. ALLOC(ASCII,mod_text,"ln",longest_name,1);
  1397. mod_end= mod_text+longest_name;/* End of |mod_text|. */
  1398.  
  1399.  
  1400.  
  1401.  
  1402. ALLOC(SECT_INFO,sect_info,"m",max_modules,0);
  1403.  
  1404.  
  1405. {
  1406. if(program==tangle)
  1407. {
  1408. ALLOC(sixteen_bits,args,"ma",max_margs,1);
  1409. max_margs++;/* So the user thinks this is really the max \#. */
  1410. }
  1411. }
  1412.  
  1413.  
  1414.  
  1415.  
  1416. CAST(name_pointer,name_dir)->byte_start= byte_ptr= byte_mem;/* position zero \
  1417.             in both arrays */
  1418. name_ptr= name_dir+1;/* |name_dir[0]| will not be used */
  1419. CAST(name_pointer,name_ptr)->byte_start= byte_mem;/* this makes name 0 of \
  1420.             length zero */
  1421.  
  1422.  
  1423.  
  1424. root= NULL;
  1425.  
  1426. ;
  1427.  
  1428. {
  1429. if(rsrvd.args)see_reserved(&rsrvd);
  1430. if(style_args)see_style(style_args,NO);
  1431.  
  1432. if(!found_web&&info_option&&!at_codes)
  1433. wrap_up();
  1434. }
  1435.  
  1436.  
  1437.  
  1438. more_includes(wt_style.Idir);
  1439.  
  1440. if(found_web)
  1441. read_aux();/* Process the \.{.aux} file. */
  1442. }
  1443.  
  1444.  
  1445.  
  1446. ASCII HUGE*
  1447. x__to_ASCII FCN((p0))
  1448. CONST outer_char HUGE*p0 C1("Character string to translate.")
  1449. {
  1450. if(translate_ASCII)
  1451. {
  1452. ASCII HUGE*buffer,HUGE*p;
  1453. CONST outer_char HUGE*q;
  1454.  
  1455. buffer= GET_MEM("x__to_ASCII arg",STRLEN(p0)+1,ASCII);
  1456.  
  1457. for(p= buffer,q= p0;*q;p++,q++)
  1458. *p= XORD(*q);
  1459. *p= '\0';
  1460.  
  1461. return buffer;
  1462. }
  1463. else
  1464. return(ASCII HUGE*)p0;
  1465. }
  1466.  
  1467.  
  1468.  
  1469. ASCII HUGE*
  1470. x_to_ASCII FCN((p0))
  1471. CONST outer_char HUGE*p0 C1("Character string to translate.")
  1472. {
  1473. static size_t bufsiz= 0;
  1474. static ASCII HUGE*buffer= NULL;
  1475.  
  1476. if(translate_ASCII)
  1477. {
  1478. ASCII HUGE*p;
  1479. CONST outer_char HUGE*q;
  1480.  
  1481. while(bufsiz<=STRLEN(p0)+1)
  1482. {
  1483. if(buffer==NULL)
  1484. buffer= GET_MEM("x_to_ASCII_buf",bufsiz= 32,ASCII);
  1485. /* Some systems don't like a |NULL| argument to |realloc|. */
  1486. else
  1487. {
  1488. buffer= (ASCII HUGE*)REALLOC(buffer,bufsiz+32,bufsiz);
  1489. bufsiz+= 32;
  1490. }
  1491.  
  1492. if(buffer==NULL)
  1493. FATAL(C,"!! No more memory (x_to_ASCII)","");
  1494. }
  1495.  
  1496. for(p= buffer,q= p0;*q;p++,q++)
  1497. *p= XORD(*q);
  1498. *p= '\0';
  1499.  
  1500. return buffer;
  1501. }
  1502. else
  1503. return(ASCII HUGE*)p0;
  1504. }
  1505.  
  1506.  
  1507.  
  1508. ASCII HUGE*
  1509. to_ASCII FCN((p0))
  1510. outer_char HUGE*p0 C1("Character string to translate.")
  1511. {
  1512. ASCII HUGE*p;
  1513.  
  1514. if(translate_ASCII)
  1515. for(p= (ASCII HUGE*)p0;*p;p++)*p= XORD(*p);
  1516.  
  1517. return(ASCII HUGE*)p0;
  1518. }
  1519.  
  1520.  
  1521.  
  1522. outer_char HUGE*
  1523. to_outer FCN((p0))
  1524. ASCII HUGE*p0 C1("Internal string to translate to outer world.")
  1525. {
  1526. outer_char HUGE*p;
  1527.  
  1528. if(translate_ASCII)
  1529. for(p= (outer_char HUGE*)p0;*p;p++)*p= XCHR(*(ASCII HUGE*)p);
  1530.  
  1531. return(outer_char HUGE*)p0;
  1532. }
  1533.  
  1534.  
  1535.  
  1536. boolean
  1537. is_include_like(VOID)
  1538. {
  1539. /* Check for \.{m4} built-in. */
  1540. if(m4&&is_in(incl_likes,id_first,id_loc))return YES;
  1541.  
  1542. /* The \.{WEB} functions behave as built-ins for \.{WEAVE}, but as macros \
  1543. for \.{TANGLE}. */
  1544. if(program==tangle)return NO;
  1545.  
  1546. if(!(*id_first==044||*id_first==0137))return NO;/* Speed up |is_in|. */
  1547. return is_in(WEB_incl_likes,id_first,id_loc);
  1548. }
  1549.  
  1550.  
  1551. SRTN conv_bi FCN((b))
  1552. BUILT_IN HUGE*b C1("")
  1553. {
  1554. for(;b->n!=0;b++)
  1555. b->name= x__to_ASCII((outer_char*)b->name);
  1556. }
  1557.  
  1558. SRTN
  1559. conv_dot FCN((d))
  1560. DOTS HUGE*d C1("")
  1561. {
  1562. for(;d->code!=0;d++)
  1563. d->symbol= x__to_ASCII((outer_char*)d->symbol);
  1564. }
  1565.  
  1566.  
  1567.  
  1568. boolean
  1569. is_in FCN((b0,p0,p1))
  1570. CONST BUILT_IN b0[]C0("Array of built-ins.")
  1571. CONST ASCII HUGE*p0 C0("Start of text.")
  1572. CONST ASCII HUGE*p1 C1("End of text.")
  1573. {
  1574. CONST BUILT_IN HUGE*b;
  1575.  
  1576. for(b= b0;b->n!=0;b++)
  1577. if(web_strcmp(b->name,b->name+b->n,p0,p1)==EQUAL)
  1578. return YES;
  1579.  
  1580. return NO;
  1581. }
  1582.  
  1583.  
  1584.  
  1585. ASCII HUGE*
  1586. uppercase FCN((p,n))
  1587. ASCII HUGE*p C0("Start of text.")
  1588. int n C1("Number of bytes to convert in place.")
  1589. {
  1590. int k;
  1591.  
  1592. for(k= 0;k<n;++k)
  1593. p[k]= A_TO_UPPER(p[k]);/* Convert $n$~bytes in place. */
  1594.  
  1595. return p;/* Return beginning address of string. */
  1596. }
  1597.  
  1598.  
  1599.  
  1600. boolean
  1601. is_dot(VOID)
  1602. {
  1603. ASCII HUGE*p;
  1604. int n;
  1605. ASCII temp[MAX_DOT_LENGTH];/* For converting the putative constant to \
  1606.                 upper case. */
  1607.  
  1608. /* Scan to the end of the dot constant (all of which are alphabetic). */
  1609. for(p= loc,n= 0;n<MAX_DOT_LENGTH;n++,p++)
  1610. if(*p==056||!isAlpha(*p))break;
  1611.  
  1612. if(*p!=056||p==loc)return NO;/* It wasn't stopped by a period, or \
  1613.     the scan didn't even get started, so it \
  1614.     can't be a dot constant. */
  1615.  
  1616. STRNCPY(temp,loc,n);
  1617. return BOOLEAN(CHOICE(dot_code(dots,uppercase(temp,n),temp+n,dot_const),
  1618. YES,NO));
  1619. }
  1620.  
  1621.  
  1622.  
  1623. eight_bits
  1624. dot_code FCN((d0,p0,p1,new_code))
  1625. DOTS HUGE*d0 C0("|DOTS| array.")
  1626. CONST ASCII HUGE*p0 C0("Start of text.")
  1627. CONST ASCII HUGE*p1 C0("End of text.")
  1628. eight_bits new_code C1("May we extend the table or not?")
  1629. {
  1630. DOTS HUGE*d;
  1631.  
  1632. re_dot:
  1633. for(d= d0;d<next_dot;d++)
  1634. if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1)==EQUAL)
  1635. {
  1636. /* Check for an overloaded operator. If so, remember the details. */
  1637. if(d->code==dot_const)
  1638. {
  1639. STRCPY(dot_op.name+1,d->symbol);
  1640. dot_op.cat= d->cat;
  1641. dot_op.num= (eight_bits)(d-dots);
  1642. }
  1643.  
  1644. return d->code;
  1645. }
  1646.  
  1647. /* Didn't find the dot constant or operator in the table. Enlarge the table \
  1648. if necessary. */
  1649. if(!new_code)return NO;/* One can add to |dots|, but not |mcmds|. */
  1650.  
  1651. if(next_dot==dots_end)
  1652. {
  1653. if((dots= (DOTS HUGE*)REALLOC(dots,
  1654. (ndots+delta_dots)*sizeof(DOTS),ndots*sizeof(DOTS)))==NULL)
  1655. OVERFLW("dot operators","d");
  1656.  
  1657. next_dot= dots+ndots;/* Next available position. */
  1658. ndots+= delta_dots;/* New total length. */
  1659. dots_end= dots+ndots;/* Upper bound. */
  1660. }
  1661.  
  1662. /* Add operator to table. */
  1663. next_dot->len= PTR_DIFF(short,p1,p0);
  1664. next_dot->symbol= GET_MEM("next_dot->symbol",next_dot->len+1,ASCII);
  1665. STRNCPY(next_dot->symbol,p0,next_dot->len);
  1666. next_dot->code= new_code;/* Mark as overloaded, or initialize. */
  1667. next_dot->cat= 1;/* ??? */
  1668. d0= next_dot++;
  1669. next_dot->len= 0;
  1670. goto re_dot;
  1671. }
  1672.  
  1673.  
  1674.  
  1675. eight_bits
  1676. is_mcmd FCN((d0,p0,p1))
  1677. DOTS HUGE*d0 C0("|DOTS| array.")
  1678. CONST ASCII HUGE*p0 C0("Start of text.")
  1679. CONST ASCII HUGE*p1 C1("End of text.")
  1680. {
  1681. DOTS HUGE*d;
  1682.  
  1683. for(d= d0;d->code;d++)
  1684. if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1)==EQUAL)
  1685. return d->code;
  1686.  
  1687. return 0;/* Not a preprocessor command. */
  1688. }
  1689.  
  1690.  
  1691.  
  1692.  
  1693. boolean
  1694. input_ln FCN((p0))
  1695. INPUT_PRMS0 HUGE*p0 C1("Which structure describes the current file?")
  1696. {
  1697. cur0_prms= p0;/* Address of current parameters. */
  1698. limit= cur_buffer;/* Initialize the top to the bottom. |limit| points to \
  1699.                 first unfilled position. */
  1700.  
  1701. cur_line++;/* A separate line count is kept for each file (including the \
  1702.         change file). */
  1703.  
  1704. /* |column_mode| and |parsing_mode| may be redundant. But don't mess with \
  1705. these. */
  1706. if(!nuweb_mode&&FORTRAN_LIKE(language)&&column_mode&&parsing_mode==OUTER)
  1707. switch(language)
  1708. {
  1709. case FORTRAN:
  1710. case FORTRAN_90:
  1711. if(!rd_Fortran())
  1712. return NO;
  1713. break;
  1714.  
  1715. case RATFOR:
  1716. case RATFOR_90:
  1717. if(!rd_Ratfor())
  1718. return NO;
  1719.  
  1720. if(limit==cur_buffer)
  1721. goto empty_line;
  1722. break;
  1723.  
  1724. default:
  1725. CONFUSION("input_ln","Invalid FORTRAN_LIKE language");
  1726. }
  1727. else
  1728. if(!rd_free_form())
  1729. return NO;
  1730.  
  1731. /* Take care of an empty line: kill the semicolon. (This is a bit shaky.) */
  1732. if(column_mode&&FORTRAN_LIKE(language)&&
  1733. PTR_DIFF(size_t,limit,cur_buffer)==2&&
  1734. ((!auto_semi&&(cur_buffer[1]==073||cur_buffer[1]==040))||
  1735. (auto_semi&&cur_buffer[1]==073&&(cur_buffer[0]=='C'||
  1736. cur_buffer[0]==0143||cur_buffer[0]==052))))
  1737. empty_line:
  1738. limit= cur_buffer;
  1739.  
  1740.  
  1741. #if(DEBUG)
  1742.  
  1743. {
  1744. register ASCII HUGE*k;
  1745.  
  1746. if(prn_input_lines&&cur_line>=(LINE_NUMBER)start_line
  1747. &&cur_line<(LINE_NUMBER)end_line)
  1748. {
  1749. if(prn_input_addresses)
  1750. printf("%lu->%lu (%u) ",
  1751. (unsigned long)cur_buffer,(unsigned long)limit,
  1752. PTR_DIFF(unsigned,limit,cur_buffer));
  1753.  
  1754. printf("%c[%d%s:%u]: \"",
  1755. (language==global_language?' ':*LANGUAGE_CODE(language)),
  1756. incl_depth,
  1757. (changing?"*":""),
  1758. cur_line);
  1759.  
  1760. for(k= cur_buffer;k<limit;++k)
  1761. switch(*k)
  1762. {
  1763. case(ASCII)begin_comment0:
  1764. printf("</*>");
  1765. break;
  1766.  
  1767. case(ASCII)begin_comment1:
  1768. printf("<//>");
  1769. break;
  1770.  
  1771. case interior_semi:
  1772. printf("<;>");
  1773. break;
  1774.  
  1775. default:
  1776. putchar(XCHR(*k));
  1777. break;
  1778. }
  1779.  
  1780. puts("\"");
  1781. }
  1782. }
  1783.  
  1784. ;
  1785. #endif
  1786.  
  1787. return YES;/* Successful read */
  1788. }
  1789.  
  1790.  
  1791.  
  1792. boolean
  1793. rd_free_form(VOID)
  1794. {
  1795. register int c= '\0';/* The character read. */
  1796. register ASCII HUGE*k;/* Where next character goes. */
  1797.  
  1798.  
  1799. {
  1800. if(num_in_buffer!=0)
  1801.  
  1802. {
  1803. STRNCPY(cur_buffer,k0,num_in_buffer);/* Move line to beginning of buffer. */
  1804. k0= cur_buffer;/* For |scan_for_cmnts| */
  1805. limit= cur_buffer+num_in_buffer-N_END;/* Reposition the end of buffer. */
  1806. num_in_buffer= 0;/* We've now cleaned out the buffer. */
  1807. }
  1808.  
  1809.  
  1810. else
  1811. {
  1812. if(feof(cur0_prms->File))
  1813. return NO;/* We have hit end-of-file. */
  1814.  
  1815.  
  1816. {
  1817. k= cur_buffer;/* beginning of buffer */
  1818.  
  1819.  
  1820. while(k<=buffer_end&&(c= getc(cur0_prms->File))!=EOF&&c!='\n')
  1821. if((*(k++)= XORD(c))!=040)limit= k;/* Update first unfilled \
  1822. position; |k|~is now pointing to next position to fill, and the last one \
  1823. wasn't blank. */
  1824.  
  1825. if(k>buffer_end)
  1826. if((c= getc(cur0_prms->File))!=EOF&&c!='\n')
  1827. {
  1828. ungetc(c,cur0_prms->File);loc= cur_buffer;TOO_LONG;
  1829.  
  1830. }
  1831.  
  1832. if(c==EOF&&limit==cur_buffer)
  1833. return NO;/* There was nothing after the last newline. */
  1834. }
  1835.  
  1836. ;
  1837. }
  1838. }
  1839.  
  1840.  
  1841.  
  1842. return YES;
  1843. }
  1844.  
  1845.  
  1846.  
  1847. boolean
  1848. rd_Fortran(VOID)
  1849. {
  1850. register int c= '\0';/* The character read. */
  1851. register ASCII HUGE*k;/* Where next character goes. */
  1852. boolean first_line= YES;
  1853.  
  1854. /* We're starting afresh; initialize flags. */
  1855. last_was_continued= NO;
  1856. scanning_C_cmnt= NO;
  1857. string_char= '\0';
  1858. in_char_string= NO;
  1859.  
  1860. /* Keep reading lines until we sense a non-comment, non-continuation line. \
  1861. Leave the latter waiting in the buffer starting at~|k0|. */
  1862. for(k= limit;;k= k0= (limit+= N_END),first_line= NO,cur_line++)
  1863. if(num_in_buffer==0)
  1864.  
  1865. {
  1866. int i;
  1867.  
  1868.  
  1869. if(feof(cur0_prms->File))
  1870. {
  1871. if(first_line)return NO;/* We have hit end-of-file. */
  1872. else goto concatenate_cmnts;/*    Don't lose the last line. */
  1873. }
  1874.  
  1875. k0= limit;/* Set the start of this line to the end of the old one. */
  1876.  
  1877.  
  1878. {
  1879. while(k<=buffer_end&&(c= getc(cur0_prms->File))!=EOF&&c!='\n')
  1880. if(c=='\t'&&k<=buffer_end-6)
  1881. for(i= 0;i<6;++i)*(k++)= 040;/* Translate tab \
  1882. character. (Don't update |limit|.) */
  1883. else
  1884. {
  1885. boolean escaped_char= NO;
  1886.  
  1887. if(c==';')c= XCHR(interior_semi);
  1888. else if(point_comments&&(*k0!=0100)&&
  1889. (escaped_char= BOOLEAN(c=='\\')))
  1890. {
  1891. c= getc(cur0_prms->File);/* What's coming up next? */
  1892.  
  1893. /* If it's not an escaped point, just copy the escape sequence. */
  1894. if(c!='!')
  1895. {
  1896. ungetc(c,cur0_prms->File);
  1897. c= '\\';
  1898. }
  1899. }
  1900.  
  1901. /* A point that's not escaped begins a short comment. */
  1902. if((*(k++)= CHOICE(is_point(c)&&!escaped_char,
  1903. (ASCII)begin_comment1,XORD(c)))!=040)
  1904. limit= k;/* Ignore trailing blanks. */
  1905. }
  1906.  
  1907. if(k>buffer_end)
  1908. if((c= getc(cur0_prms->File))!=EOF&&c!='\n')
  1909. {
  1910. ungetc(c,cur0_prms->File);loc= cur_buffer;TOO_LONG;
  1911.  
  1912. }
  1913.  
  1914. if(c==EOF&&limit==cur_buffer)return NO;/* there was nothing after \
  1915.     the last newline */
  1916. }
  1917.  
  1918. ;/* |limit| is positioned after the last char.\ read. */
  1919.  
  1920. /* We will allow two extra characters at the end, in case we need to put \
  1921. end-of-comment markers there; we also need two bytes for Tangle's workspace. */
  1922. MEMSET(limit,040,N_END);
  1923. num_in_buffer= 0;/* There's nothing waiting. */
  1924.  
  1925. /* If we've read into a |new_module| command in column~1, \
  1926.     prepare to switch out of column mode. */
  1927. at_line= BOOLEAN(*k0==0100&&*(k0+1)!=057);
  1928.  
  1929. if(at_line&&(*(k0+1)==052||*(k0+1)==040))found_at= YES;
  1930.  
  1931. /* If we were appending, then we must delay shifting out of column mode until \
  1932. we process the first part of the buffer. However, if we're actually at the \
  1933. beginning of the buffer, then we must shift out of column mode immediately. */
  1934. if(found_at&&k0==cur_buffer)goto out_of_column_mode;
  1935.  
  1936. if(first_line&&at_line)break;
  1937.  
  1938. /* Now we look at the line we just put into the buffer. Usually, we should \
  1939. look at that to see whether it's a continuation or a comment line, because if \
  1940. so we keep on reading. However, if it's a command line, or if we're in the \
  1941. middle of handling a trailing C~comment which didn't end on the previous \
  1942. line, then this line should not be treated in column mode. */
  1943. if(scanning_C_cmnt)
  1944. {
  1945. scan_for_cmnts();
  1946. continue;
  1947. }
  1948.  
  1949. if(!(at_line||scanning_C_cmnt))
  1950.  
  1951. {
  1952. boolean is_cmnt= NO,Fortran_cmnt= NO,C_cmnt= NO;
  1953.  
  1954. ASCII HUGE*p= k0;/* Points to the comment character. */
  1955.  
  1956.  
  1957. /* Did we get a comment line?  */
  1958. switch(*k0)
  1959. {
  1960. case 0103:
  1961. case 0143:
  1962. case 052:
  1963. case(ASCII)begin_comment0:
  1964. case(ASCII)begin_comment1:
  1965. is_cmnt= Fortran_cmnt= YES;
  1966. break;
  1967.  
  1968. default:
  1969. /* Skip over white space at beginning of line. */
  1970. for(;p<limit;p++)if(*p!=040)break;
  1971.  
  1972. if((*p==057&&(*(p+1)==052
  1973. ||(*(p+1)==057&&Cpp_comments)))
  1974. ||*p==(ASCII)begin_comment0
  1975. ||*p==(ASCII)begin_comment1)is_cmnt= C_cmnt= YES;
  1976. break;
  1977. }
  1978.  
  1979. if(is_cmnt)
  1980. {
  1981. if(limit==k0+1)
  1982. {/* Null comment line. */
  1983. limit= k0;
  1984. if(!first_line)goto last_of_read;
  1985. else goto concatenate_cmnts;
  1986. }
  1987.  
  1988. if(k0>cur_buffer)MEMSET(k0-N_END,040,N_END);
  1989.  
  1990. if(Fortran_cmnt)*p= begin_comment1;
  1991.  
  1992. /* If the last line was empty, we don't want to read any further; leave this \
  1993. comment waiting in the buffer. */
  1994. if(last_was_empty)
  1995. {
  1996. num_in_buffer= PTR_DIFF(size_t,limit,k0)+N_END;
  1997. comment_in_buffer= YES;
  1998. limit= cur_buffer;
  1999. break;/* Break out of the |for| loop which reads lines. */
  2000. }
  2001.  
  2002. scan_for_cmnts();
  2003. continue;/* Go back and read more lines. */
  2004. }
  2005.  
  2006.  
  2007.  
  2008.  
  2009. /* If we're this far, it's not a comment. Check for continuation line \
  2010. (neither blank nor |'0'| in column~6). If \
  2011. so, shift it over to abut it with previous stuff in buffer. */
  2012. if(limit-k0>=5&&!(k0[5]==040||k0[5]==060))
  2013.  
  2014. {
  2015. register ASCII HUGE*l;
  2016. boolean stuff_in_1_5;
  2017.  
  2018.  
  2019. if(first_line)
  2020. {/* Error: Continuation line not expected. */
  2021. scan_for_cmnts();
  2022. continue;
  2023. }
  2024.  
  2025. /* We don't allow anything in columns 1--5 for a continuation line. That's \
  2026. a FORTRAN rule, and it helps us to catch a possible continuation of a \
  2027. C-style comment. */
  2028. stuff_in_1_5= NO;
  2029.  
  2030. for(l= k0;l<k0+5;++l)
  2031. if(*l!=040)
  2032. {
  2033. stuff_in_1_5= YES;
  2034. break;
  2035. }
  2036.  
  2037. /*  If there's stuff in columns 1--5, it's not a continuation line. \
  2038. Otherwise, it's a continuation line; abut it with the code in the previous \
  2039. line. */
  2040. if(stuff_in_1_5)goto neither_cmnt_nor_continuation;
  2041.  
  2042. *l= 040;/* Delete the continuation symbol. */
  2043. scan_for_cmnts();
  2044. continue;/* Keep on reading. */
  2045. }
  2046.  
  2047.  
  2048. }
  2049.  
  2050.  
  2051.  
  2052.  
  2053. /* If we get to here, it's neither a comment nor a continuation. If this line \
  2054. was the first in the buffer, we must continue to read more.  (However, \
  2055. if this line is null, then we do not read any more, because we don't want to \
  2056. concatenate a null comment to the previous line.) Otherwise, we're \
  2057. done reading and we should leave this line waiting in the buffer. */
  2058. neither_cmnt_nor_continuation:
  2059. if(first_line)
  2060. if(limit==cur_buffer)/* Quit on null first line. */
  2061. {
  2062. comment_in_buffer= NO;
  2063. num_in_buffer= 0;
  2064. break;
  2065. }
  2066. else
  2067. {
  2068. scan_for_cmnts();
  2069. continue;/* We must read some    more to see if next is \
  2070. continuation. */
  2071. }
  2072.  
  2073.  
  2074. {
  2075. last_of_read:
  2076. if(!first_line)
  2077. {
  2078. num_in_buffer= PTR_DIFF(size_t,limit,k0)+N_END;
  2079. limit= MAX(k0-N_WORK,cur_buffer);
  2080. }
  2081. else limit+= N_WORK;
  2082.  
  2083. concatenate_cmnts:
  2084. anlz_cmnts();/* Concatenate comments appropriately, and set |scanning_C_cmnt|. */
  2085.  
  2086. cur_line--;
  2087. break;/* Break out of |for| loop. */
  2088. }
  2089.  
  2090. ;
  2091. }
  2092.  
  2093.  
  2094. else
  2095.  
  2096. {
  2097.  
  2098. {
  2099. STRNCPY(cur_buffer,k0,num_in_buffer);/* Move line to beginning of buffer. */
  2100. k0= cur_buffer;/* For |scan_for_cmnts| */
  2101. limit= cur_buffer+num_in_buffer-N_END;/* Reposition the end of buffer. */
  2102. num_in_buffer= 0;/* We've now cleaned out the buffer. */
  2103. }
  2104.  
  2105. ;
  2106.  
  2107. /* If what was waiting was a control line, we must shift out of column mode. */
  2108. if(found_at)
  2109. {
  2110. out_of_column_mode:
  2111. found_at= column_mode= last_was_empty= NO;
  2112. break;/* Break out of |for| loop which reads lines. The finish-read \
  2113.             material is moot. */
  2114. }
  2115.  
  2116. if(at_line)
  2117. {
  2118. last_was_empty= NO;
  2119. break;
  2120. }
  2121.  
  2122. /* Finally, we give special treatment to empty lines. */
  2123. last_was_empty= BOOLEAN(limit==cur_buffer);
  2124. scan_for_cmnts();
  2125. }/* Go back to the |for| loop which reads lines. */
  2126.  
  2127.  
  2128.  
  2129. /* Except for new module, throw away all stuff after \.{@}~command in \
  2130. column~1. */
  2131. if(*cur_buffer==0100&&!(limit==cur_buffer+1||*(cur_buffer+1)==052||
  2132. *(cur_buffer+1)==040))
  2133. for(k= cur_buffer+2;k<limit;++k)
  2134. if(*k==073)
  2135. {
  2136. *k= 040;
  2137. break;
  2138. }
  2139.  
  2140. return YES;
  2141. }
  2142.  
  2143.  
  2144.  
  2145. SRTN
  2146. mark_cmnt FCN((type0,delim0,length0,pos0))
  2147. CMNT_TYPE type0 C0("")
  2148. DELIM_TYPE delim0 C0("")
  2149. eight_bits length0 C0("")
  2150. ASCII HUGE*pos0 C1("")
  2151. {
  2152. pcmnt->type= type0;
  2153. pcmnt->delim= delim0;
  2154. pcmnt->len= length0;
  2155. pcmnt->pos= pos0;
  2156.  
  2157. if(type0==LONG_CMNT)scanning_C_cmnt= BOOLEAN(delim0==START);
  2158.  
  2159. pcmnt++;
  2160. pcmnt->type= NO_CMNT;
  2161. pcmnt->delim= START;
  2162. pcmnt->len= 0;
  2163. pcmnt->pos= limit;
  2164. }
  2165.  
  2166.  
  2167.  
  2168. SRTN
  2169. scan_for_cmnts(VOID)
  2170. {
  2171. register ASCII HUGE*p;
  2172.  
  2173. for(p= k0;p<limit;p++)
  2174. switch(*p)
  2175. {
  2176. case(ASCII)begin_comment0:
  2177. if(scanning_C_cmnt)
  2178. break;
  2179.  
  2180. MARK(LONG_CMNT,START,1);
  2181. break;
  2182.  
  2183. case(ASCII)begin_comment1:
  2184. if(scanning_C_cmnt)
  2185. break;
  2186.  
  2187. MARK(SHORT_CMNT,START,1);
  2188. p= limit;
  2189. MARK(SHORT_CMNT,END,0);
  2190. break;
  2191.  
  2192. case 047:
  2193. case 042:
  2194. if(!scanning_C_cmnt)
  2195.  
  2196. {
  2197. if(!in_char_string)
  2198. {
  2199. in_char_string= YES;
  2200. string_char= *p;
  2201. break;
  2202. }
  2203.  
  2204. if(string_char==*p&&p[1]==string_char)
  2205. {
  2206. p++;
  2207. break;
  2208. }
  2209.  
  2210. in_char_string= NO;
  2211. }
  2212.  
  2213.  
  2214. break;
  2215.  
  2216. case 057:
  2217. if(in_char_string||scanning_C_cmnt)
  2218. break;
  2219.  
  2220. if(*(p+1)==057&&Cpp_comments)
  2221. {
  2222. MARK(SHORT_CMNT,START,2);
  2223. p= limit;
  2224. MARK(SHORT_CMNT,END,0);
  2225. }
  2226. else if(*(p+1)==052)
  2227. {
  2228. MARK(LONG_CMNT,START,2);
  2229. p++;
  2230. }
  2231.  
  2232. break;
  2233.  
  2234. case 052:
  2235. if(in_char_string)
  2236. break;
  2237.  
  2238. if(scanning_C_cmnt&&*(p+1)==057)
  2239. {
  2240. MARK(LONG_CMNT,END,2);
  2241. p++;
  2242. }
  2243.  
  2244. break;
  2245. }
  2246. }
  2247.  
  2248.  
  2249.  
  2250. SRTN
  2251. anlz_cmnts(VOID)
  2252. {
  2253. CMNT_DATA*d;
  2254. boolean found_text= NO;
  2255. ASCII HUGE*l;
  2256.  
  2257. pcmnt->pos= limit;
  2258.  
  2259. for(d= posns+1;d<pcmnt;d+= 2)
  2260. {
  2261. found_text= NO;
  2262.  
  2263. for(l= d->pos+d->len;l<(d+1)->pos;l++)
  2264. if(*l!=040)
  2265. {
  2266. found_text= YES;
  2267. break;
  2268. }
  2269.  
  2270. if(found_text)
  2271. {
  2272. if(d->type==SHORT_CMNT)
  2273. {
  2274. BLANK_OUT(d-1);
  2275. *((d-1)->pos)= begin_comment0;
  2276. *(d->pos)= 052;
  2277. *(d->pos+1)= 057;
  2278. }
  2279. }
  2280. else if(d->type==(d+1)->type)
  2281. {
  2282. BLANK_OUT(d);
  2283. BLANK_OUT(d+1);
  2284. d->type= (d+1)->type= NO_CMNT;
  2285. }
  2286. }
  2287.  
  2288.  
  2289. {
  2290. boolean text_after= NO;
  2291.  
  2292. if(pcmnt>posns)
  2293. {/* There's at least one comment. */
  2294. if(!scanning_C_cmnt)
  2295. for(l= limit-1;l>(pcmnt-1)->pos+(pcmnt-1)->len;l--)
  2296. if(*l!=040)
  2297. {/* There's text after the comment. */
  2298. text_after= YES;
  2299. *(l+1)= 073;
  2300. break;
  2301. }
  2302.  
  2303. if(!text_after)
  2304. {
  2305. pcmnt-= 2;
  2306.  
  2307. if(pcmnt<posns)
  2308. {
  2309.  
  2310. err0_print(ERR_C,OC("Fortran comment didn't end; missing */?"),0);
  2311. pcmnt= posns;
  2312. }
  2313.  
  2314. while(pcmnt->type==NO_CMNT)
  2315. {
  2316. pcmnt--;
  2317.  
  2318. if(pcmnt<posns)
  2319. CONFUSION("Insert an automatic semicolon",
  2320. "Invalid comment structure");
  2321. }
  2322.  
  2323. for(l= pcmnt->pos-1;l>=cur_buffer;l--)
  2324. {
  2325. if(*l!=040)
  2326. {/* There's text before the comment. */
  2327. semi_pos= pcmnt->pos;
  2328.  
  2329. {
  2330. *(semi_pos+1)= (ASCII)(((pcmnt+1)->type==LONG_CMNT?begin_comment0:
  2331. begin_comment1));/* If the comment was started by \
  2332.     |begin_comment0| or |begin_comment1|, this overwrites the character \
  2333.     after that. (We \
  2334.     have to make room for the semicolon.) If we want to cure this, we \
  2335.     must do more copying. */
  2336.  
  2337. if(semi_pos>cur_buffer&&*(semi_pos-1)==0100)/* A verbatim comment. */
  2338. {
  2339. *(semi_pos--)= 0100;
  2340. }
  2341.  
  2342. *semi_pos= 073;/* This overwrites the beginning of the comment marker, \
  2343.     or the previous~\.{@} if there was one. */
  2344.  
  2345.  
  2346.  
  2347. for(lp= semi_pos-1;lp>cur_buffer;lp--)
  2348. {
  2349. if(*lp==040)continue;
  2350.  
  2351. if(*lp==057&&*(--lp)==0100)
  2352. {
  2353. *semi_pos= 040;
  2354. *lp= 073;*(lp+1)= 0100;*(lp+2)= 057;
  2355. }
  2356. break;
  2357. }
  2358.  
  2359.  
  2360. ;
  2361. }
  2362.  
  2363.  
  2364. break;
  2365. }
  2366. }
  2367. }
  2368. }
  2369. else
  2370. {/* No comments at all. */
  2371. for(l= limit-1;l>=cur_buffer;l--)
  2372. if(*l!=040)
  2373. {
  2374. *(l+1)= 073;
  2375. break;
  2376. }
  2377. }
  2378. }
  2379.  
  2380.  
  2381.  
  2382. pcmnt= posns;/* Reset. */
  2383. }
  2384.  
  2385.  
  2386.  
  2387. boolean
  2388. rd_Ratfor(VOID)
  2389. {
  2390. register int c= '\0';/* The character read. */
  2391. register ASCII HUGE*k;/* Where next character goes. */
  2392. boolean found_semi;
  2393.  
  2394. string_char= '\0';
  2395. in_char_string= NO;
  2396.  
  2397.  
  2398. {
  2399. if(num_in_buffer!=0)
  2400.  
  2401. {
  2402. STRNCPY(cur_buffer,k0,num_in_buffer);/* Move line to beginning of buffer. */
  2403. k0= cur_buffer;/* For |scan_for_cmnts| */
  2404. limit= cur_buffer+num_in_buffer-N_END;/* Reposition the end of buffer. */
  2405. num_in_buffer= 0;/* We've now cleaned out the buffer. */
  2406. }
  2407.  
  2408.  
  2409. else
  2410. {
  2411. if(feof(cur0_prms->File))
  2412. return NO;/* We have hit end-of-file. */
  2413.  
  2414.  
  2415. {
  2416. k= cur_buffer;/* beginning of buffer */
  2417.  
  2418.  
  2419. while(k<=buffer_end&&(c= getc(cur0_prms->File))!=EOF&&c!='\n')
  2420. if((*(k++)= XORD(c))!=040)limit= k;/* Update first unfilled \
  2421. position; |k|~is now pointing to next position to fill, and the last one \
  2422. wasn't blank. */
  2423.  
  2424. if(k>buffer_end)
  2425. if((c= getc(cur0_prms->File))!=EOF&&c!='\n')
  2426. {
  2427. ungetc(c,cur0_prms->File);loc= cur_buffer;TOO_LONG;
  2428.  
  2429. }
  2430.  
  2431. if(c==EOF&&limit==cur_buffer)
  2432. return NO;/* There was nothing after the last newline. */
  2433. }
  2434.  
  2435. ;
  2436. }
  2437. }
  2438.  
  2439.  
  2440.  
  2441. /* If we've read into a |new_module| command in column~1, \
  2442.     switch out of column mode. */
  2443. if(*cur_buffer==0100&&(limit==cur_buffer+1
  2444. ||*(cur_buffer+1)==052||*(cur_buffer+1)==040))
  2445. column_mode= NO;
  2446. else
  2447.  
  2448. {
  2449. last_was_continued= continuing_line;
  2450. continuing_line= NO;
  2451.  
  2452. if(limit==cur_buffer)
  2453. return YES;
  2454.  
  2455. limit[0]= limit[1]= limit[2]= limit[3]= 040;
  2456.  
  2457. cmnt_char= 043;
  2458.  
  2459. found_semi= found_text= text= NO;/* Start off assuming we're in comment \
  2460. mode. */
  2461. semi_pos= NULL;/* |semi_pos| will record the position of a prospective \
  2462. comment, to be begun by a semicolon. */
  2463.  
  2464. /* Scan the line. */
  2465. if(!free_form_input&&!(*cur_buffer==0100&&*(cur_buffer+1)==043))
  2466. {
  2467. for(lp= cur_buffer;;)
  2468. if(!skip_Rtext()||!skp_cmnt())break;
  2469.  
  2470. switch(*last_pos)
  2471. {
  2472. case 053:case 055:case 052:case 075:case 0173:case 0175:
  2473. case 0136:case 046:case 0174:case 050:case 072:
  2474. case 076:case 074:case 0133:case 054:case 0134:
  2475. continuing_line= YES;
  2476. break;/* Line is continued. */
  2477.  
  2478. /* Ratfor's continuation character. */
  2479. case 0137:
  2480. if(last_pos>cur_buffer)
  2481. {
  2482. ASCII c;
  2483.  
  2484. c= *(last_pos-1);
  2485. if(isAlpha(c)||isDigit(c)||
  2486. c==0137||c==044)
  2487. goto not_continuation;
  2488. }
  2489. *last_pos= 040;
  2490. continuing_line= YES;
  2491. break;
  2492.  
  2493. default:
  2494. not_continuation:
  2495. if(!auto_semi)break;
  2496.  
  2497. /* If the last construction is a comment (|!text|) and there was actually \
  2498. some text (|semi_pos!=NULL|), \
  2499. replace ``\.{\slashstar}'' by |';'| and |begin_comment0| or \
  2500. |begin_comment1|. */
  2501. if(!text&&semi_pos!=NULL)
  2502. {
  2503. *(semi_pos+1)= (ASCII)(((pcmnt+1)->type==LONG_CMNT?begin_comment0:
  2504. begin_comment1));/* If the comment was started by \
  2505.     |begin_comment0| or |begin_comment1|, this overwrites the character \
  2506.     after that. (We \
  2507.     have to make room for the semicolon.) If we want to cure this, we \
  2508.     must do more copying. */
  2509.  
  2510. if(semi_pos>cur_buffer&&*(semi_pos-1)==0100)/* A verbatim comment. */
  2511. {
  2512. *(semi_pos--)= 0100;
  2513. }
  2514.  
  2515. *semi_pos= 073;/* This overwrites the beginning of the comment marker, \
  2516.     or the previous~\.{@} if there was one. */
  2517.  
  2518.  
  2519.  
  2520. for(lp= semi_pos-1;lp>cur_buffer;lp--)
  2521. {
  2522. if(*lp==040)continue;
  2523.  
  2524. if(*lp==057&&*(--lp)==0100)
  2525. {
  2526. *semi_pos= 040;
  2527. *lp= 073;*(lp+1)= 0100;*(lp+2)= 057;
  2528. }
  2529. break;
  2530. }
  2531.  
  2532.  
  2533. ;
  2534. }
  2535.  
  2536.  
  2537. else if(found_text&&limit>cur_buffer)*limit++= 073;
  2538. /* Line ended. */
  2539. break;
  2540. }
  2541. }
  2542. }
  2543.  
  2544. ;
  2545.  
  2546. return YES;
  2547. }
  2548.  
  2549.  
  2550. boolean skip_Rtext(VOID)
  2551. {
  2552. static ASCII blank= 040;
  2553.  
  2554.  
  2555.  
  2556. if(scanning_C_cmnt)return YES;/* Make sure |skp_cmnt| is the first to be \
  2557.                     executed. */
  2558.  
  2559. /* Start scanning at the current position. Skip over white space. */
  2560. for(;lp<limit;++lp)
  2561. if(!(*lp==040||*lp==tab_mark))break;
  2562.  
  2563. if(lp>=limit)return NO;/* The line was all white space. */
  2564.  
  2565. ;
  2566.  
  2567. last_pos= ␣
  2568.  
  2569. /* If we haven't found a comment, set mode to text. */
  2570. if(!start_Rcomment)
  2571. {
  2572. found_text= text= YES;
  2573. }
  2574.  
  2575. /* Scan to a comment. */
  2576. for(;lp<limit;lp++)
  2577. {
  2578. if(start_Rcomment)
  2579. {
  2580. if(R_style_cmnt)
  2581. {
  2582. *lp= cmnt_char= begin_comment0;
  2583. *limit++= 052;*limit++= 057;
  2584. }
  2585. if(++lp<limit)return YES;
  2586. }
  2587.  
  2588. if(*lp!=040&&*lp!=tab_mark)
  2589. last_pos= lp;/* Remember last non-blank position. */
  2590. }
  2591.  
  2592. return NO;
  2593. }
  2594.  
  2595.  
  2596. boolean skp_cmnt(VOID)
  2597. {
  2598. /* If the last mode was text, remember the position for a possible semi. */
  2599. if(text)semi_pos= lp-1;
  2600.  
  2601. text= NO;/* We're in comment mode. */
  2602. scanning_C_cmnt= NO;/* Flag used to handle the next line properly if the \
  2603.                 comment runs over. */
  2604.  
  2605. /* Scan to end of comment. */
  2606. if(C_style_cmnt)
  2607. {
  2608. if(short_cmnt)
  2609. {
  2610. lp= limit;
  2611. return YES;
  2612. }
  2613.  
  2614. for(++lp;lp<limit;lp++)
  2615. {
  2616. if(*lp==(ASCII)begin_comment0||*lp==(ASCII)begin_comment1)
  2617. {
  2618. *lp= 0143;
  2619. continue;
  2620. }
  2621.  
  2622. if(*lp==052&&*(lp+1)==057)
  2623. {
  2624. lp+= 2;/* Position after end of comment. */
  2625. if(lp<=limit)return YES;
  2626. }
  2627. }
  2628.  
  2629. scanning_C_cmnt= YES;
  2630. }
  2631. else
  2632. {
  2633. for(++lp;lp<limit;lp++)
  2634. if(*lp==(ASCII)begin_comment1)
  2635. *lp= 041;
  2636.  
  2637. *(limit-2)= 052;*(limit-1)= 057;
  2638. }
  2639.  
  2640. return NO;
  2641. }
  2642.  
  2643.  
  2644.  
  2645. SRTN
  2646. prime_the_change_buffer(VOID)
  2647. {
  2648. INPUT_PARAMS input_params;/* Saves incoming state. */
  2649.  
  2650. input_params.Language= language;
  2651. input_params.Parsing_mode= parsing_mode;
  2652. input_params.Column_mode= column_mode;
  2653.  
  2654. language= change_params.Language;
  2655. parsing_mode= change_params.Parsing_mode;
  2656. column_mode= change_params.Column_mode;
  2657.  
  2658. change_limit= NULL;/* This value will be used if the change file ends. */
  2659.  
  2660.  
  2661.  
  2662. WHILE()
  2663. {
  2664. ASCII c;
  2665.  
  2666. if(!input_ln(CHANGE_FILE))
  2667. {
  2668. change_limit= NULL;
  2669. goto done_priming;
  2670. }
  2671.  
  2672. if(limit<cur_buffer+2)continue;
  2673. /* There can't be an \.{@}~command. */
  2674. if(cur_buffer[0]!=0100)continue;
  2675. /* Skip lines that don't start with~\.{@}. */
  2676.  
  2677.  
  2678. if((cur_buffer[1]>=0130&&cur_buffer[1]<=0132)||cur_buffer[1]==0111)
  2679. cur_buffer[1]+= 0172-0132;
  2680.  
  2681. ;
  2682.  
  2683.  
  2684. if(cur_buffer[1]==0151)
  2685. {
  2686. loc= cur_buffer+2;
  2687.  
  2688. err0_print(ERR_C,OC("Sorry, no includes allowed in change file"),0);
  2689.  
  2690. }
  2691.  
  2692. ;
  2693. if((c= cur_buffer[1])==0170)break;/* Found beginning of a change. */
  2694.  
  2695. if(c==0171||c==0172)
  2696. {
  2697. loc= cur_buffer+2;/* Skip erroneous change. */
  2698.  
  2699. err0_print(ERR_C,OC("Where is the matching @x?"),0);
  2700.  
  2701. }
  2702. else
  2703. {
  2704. if(c==0154)
  2705. if(limit==cur_buffer+2)
  2706.  
  2707. err0_print(ERR_C,OC("Missing language character after @L"),0);
  2708. else c= cur_buffer[2];
  2709.  
  2710. switch(c)
  2711. {
  2712.  
  2713. case 0143:case 0103
  2714.  
  2715. :
  2716. language= change_params.Language= 
  2717. (cur_buffer[2]==053)?C_PLUS_PLUS:C;
  2718. column_mode= change_params.Column_mode= NO;
  2719. continue;
  2720.  
  2721.  
  2722. case 0162:case 0122
  2723.  
  2724. :
  2725. if(!RAT_OK("Language change ignored"))continue;
  2726.  
  2727. language= change_params.Language= 
  2728. (cur_buffer[2]==071)?RATFOR_90:RATFOR;
  2729. continue;
  2730.  
  2731.  
  2732. case 0156:case 0116
  2733.  
  2734. :
  2735. language= change_params.Language= 
  2736. (cur_buffer[2]==071)?FORTRAN_90:FORTRAN;
  2737. continue;
  2738.  
  2739.  
  2740. case 0166:case 0126
  2741.  
  2742.  
  2743.  
  2744. :
  2745. language= change_params.Language= LITERAL;continue;
  2746.  
  2747.  
  2748. case 0170:case 0130
  2749.  
  2750. :
  2751. language= change_params.Language= TEX;continue;
  2752.  
  2753. case 0133:
  2754. column_mode= change_params.Column_mode= YES;continue;
  2755.  
  2756. case 0135:
  2757. column_mode= change_params.Column_mode= NO;continue;
  2758.  
  2759. default:
  2760. loc= cur_buffer+2;
  2761.  
  2762. err0_print(ERR_C,OC("Invalid @ command in change file"),0);
  2763. continue;
  2764. }
  2765. }
  2766.  
  2767.  
  2768. }
  2769.  
  2770. ;
  2771.  
  2772.  
  2773. do
  2774. {
  2775. if(!input_ln(CHANGE_FILE))
  2776. {
  2777.  
  2778. err0_print(ERR_C,OC("Change file ended after @x"),0);
  2779.  
  2780. change_limit= NULL;
  2781. goto done_priming;
  2782. }
  2783. }
  2784. while(limit==cur_buffer);
  2785.  
  2786. ;
  2787.  
  2788. done_priming:
  2789. language= input_params.Language;
  2790. parsing_mode= input_params.Parsing_mode;
  2791. column_mode= input_params.Column_mode;
  2792.  
  2793. /* After we're done priming the change buffer, we will next read from the \
  2794. input file. */
  2795. changing= NO;
  2796. cur0_prms= cur_prms.web;
  2797. }
  2798.  
  2799.  
  2800.  
  2801. SRTN
  2802. chk_change(VOID)/* Switches to |change_file| if the buffers match. */
  2803. {
  2804. int n= 0;/* The number of discrepancies found. */
  2805.  
  2806. if(LINES_DONT_MATCH)return;/* Didn't match a change. */
  2807.  
  2808. WHILE()
  2809. {
  2810. changing= YES;prn_where= YES;
  2811.  
  2812. if(!input_ln(CHANGE_FILE))
  2813. {
  2814.  
  2815. err0_print(ERR_C,OC("Change file ended before @y"),0);
  2816.  
  2817. change_limit= NULL;changing= NO;prn_where= YES;
  2818. return;
  2819. }
  2820.  
  2821.  
  2822.  
  2823. if(limit>cur_buffer+1&&cur_buffer[0]==0100)
  2824. {
  2825.  
  2826.  
  2827. if((cur_buffer[1]>=0130&&cur_buffer[1]<=0132)||cur_buffer[1]==0111)
  2828. cur_buffer[1]+= 0172-0132;
  2829.  
  2830. ;
  2831.  
  2832.  
  2833. if(cur_buffer[1]==0151)
  2834. {
  2835. loc= cur_buffer+2;
  2836.  
  2837. err0_print(ERR_C,OC("Sorry, no includes allowed in change file"),0);
  2838.  
  2839. }
  2840.  
  2841. ;
  2842.  
  2843. if(cur_buffer[1]==0170||cur_buffer[1]==0172)
  2844. {
  2845. loc= cur_buffer+2;
  2846.  
  2847. err0_print(ERR_C,OC("Where is the matching @y?"),0);
  2848.  
  2849. }
  2850. else if(cur_buffer[1]==0171)
  2851. {
  2852. if(n>0)
  2853. {
  2854. loc= cur_buffer+2;
  2855.  
  2856. err0_print(ERR_C,OC("Hmm... some of the preceding lines failed to match"),0);
  2857.  
  2858. }
  2859. return;
  2860. }
  2861. }
  2862.  
  2863. ;
  2864. changing= NO;prn_where= YES;
  2865.  
  2866. while(!input_ln(INPUT_FILE))
  2867. {/* Pop the stack or quit. */
  2868. if(incl_depth==WEB_FILE)
  2869. {
  2870.  
  2871. err0_print(ERR_C,OC("WEB file ended during a change"),0);
  2872.  
  2873. input_has_ended= YES;return;
  2874. }
  2875.  
  2876. incl_depth--;prn_where= YES;
  2877. }
  2878.  
  2879. if(LINES_DONT_MATCH)n++;
  2880. }
  2881. }
  2882.  
  2883.  
  2884. #endif /* Part 1 */
  2885.  
  2886. #if(part != 1)
  2887.  
  2888.  
  2889. SRTN
  2890. rst_input(VOID)
  2891. {
  2892. FCLOSE(prms[WEB_FILE].web.File);
  2893. FCLOSE(prms[WEB_FILE].change.File);
  2894.  
  2895. ini_input_prms(WEB_FILE,(outer_char HUGE*)"",ABORT_ON_ERROR);
  2896.  
  2897.  
  2898. limit= cur_buffer;loc= cur_buffer+1;cur_buffer[0]= 040
  2899.  
  2900. ;
  2901.  
  2902.  
  2903. {
  2904. cur0_prms= cur_prms.change;
  2905. changing= YES;
  2906. change_params= change_params0;/* Reset to default values. */
  2907. prime_the_change_buffer();
  2908.  
  2909.  
  2910. limit= cur_buffer;loc= cur_buffer+1;cur_buffer[0]= 040
  2911.  
  2912. ;
  2913. }
  2914.  
  2915.  
  2916.  
  2917. incl_depth= WEB_FILE;
  2918. input_has_ended= NO;
  2919. }
  2920.  
  2921.  
  2922.  
  2923. boolean
  2924. ini_input_prms FCN((ilevel,path,quit_on_error))
  2925. int ilevel C0("Present level of input files.")
  2926. outer_char HUGE*path C0("Colon-delimited path list")
  2927. boolean quit_on_error C1("Abort flag.")
  2928. {
  2929. INPUT_PRMS HUGE*p= &prms[ilevel];
  2930. CUR_PRMS old_prms;
  2931. boolean web_level= BOOLEAN(ilevel==WEB_FILE);
  2932.  
  2933. old_prms= cur_prms;/* Save state in case of error. */
  2934.  
  2935. /* Initialize this here in case of error messages. */
  2936. cur_prms.web= &p->web;
  2937. cur_prms.change= &p->change;
  2938.  
  2939. /* Initialize both input and change files; abort if error. */
  2940. if(!(ini0_input_prms(cur_prms.web,path,OC("input"),quit_on_error,
  2941. (SEQUENCES*)(web_level?wt_style.input_ext.web:
  2942. wt_style.input_ext.hweb))&&
  2943. ini0_input_prms(cur_prms.change,path,OC("change"),quit_on_error,
  2944. (SEQUENCES*)(web_level?wt_style.input_ext.change:
  2945. wt_style.input_ext.hchange))))
  2946. {
  2947. cur_prms= old_prms;/* Restore old state if error. */
  2948. return NO;
  2949. }
  2950.  
  2951. /* For definiteness we set |cur0_prms| to the web input file. */
  2952. cur0_prms= cur_prms.web;
  2953. loc= cur_buffer;
  2954.  
  2955. /* Remember the name of the include file, for use by \WEAVE. */
  2956. STRCPY(this_include_file,web_level?
  2957. (CONST outer_char*)"":p->web.File_name);
  2958.  
  2959. return YES;
  2960. }
  2961.  
  2962.  
  2963.  
  2964. boolean
  2965. ini0_input_prms FCN((p0,path,file_type,quit_on_error,extensions))
  2966. INPUT_PRMS0 HUGE*p0 C0("")
  2967. outer_char HUGE*path C0("")
  2968. outer_char file_type[]C0("")
  2969. boolean quit_on_error C0("")
  2970. SEQUENCES*extensions C1("")
  2971. {
  2972. cur0_prms= p0;/* In case of error messages. */
  2973.  
  2974. /* If we've never opened this level before, allocate appropriate space. */
  2975. if(p0->Buffer==NULL)
  2976. {
  2977. ALLOC(ASCII,p0->Buffer,"bs",buf_size,0);
  2978. p0->Buffer_end= p0->Buffer+buf_size-2;
  2979. }
  2980.  
  2981. /* Initialize location pointers and flags. */
  2982. loc= p0->Limit= p0->Buffer;
  2983. p0->Line= 0;
  2984. p0->Num_in_buffer= 0;
  2985. p0->Scanning_C_cmnt= p0->Last_was_empty
  2986. = p0->Continuing_line= p0->Last_was_continued= NO;
  2987.  
  2988. /* --- Open file (but not if it's already open) --- */
  2989. if(!p0->File&&
  2990. (p0->File= xopen(p0->File_name,path,extensions,OC("r")))==NULL)
  2991. {
  2992. if(quit_on_error)
  2993. {
  2994. char temp[100];
  2995.  
  2996. sprintf(temp,"!! Can't open %s%s file ",
  2997. *p0->File_name?"":"(null) ",(char*)file_type);
  2998. FATAL(C,temp,*p0->File_name?p0->File_name:
  2999. wt_style.null_file_name);
  3000.  
  3001.  
  3002. }
  3003. else
  3004. {
  3005.  
  3006. err0_print(ERR_C,OC("Can't open include %s file \"%s\""),2,file_type,p0->File_name);
  3007. }
  3008.  
  3009. return NO;/* Couldn't open file. */
  3010. }
  3011.  
  3012. return YES;/* Opened file successfully. */
  3013. }
  3014.  
  3015.  
  3016.  
  3017. FILE*
  3018. xopen FCN((file_name,path,extensions,iomode))
  3019. outer_char*file_name C0("")
  3020. outer_char HUGE*path C0("")
  3021. SEQUENCES*extensions C0("")
  3022. CONST outer_char*iomode C1("")
  3023. {
  3024. outer_char HUGE*p1;
  3025. FILE*file_ptr;
  3026. outer_char total_name[2*MAX_FILE_NAME_LENGTH];
  3027. outer_char prefix_end_str[2];
  3028.  
  3029. if(!*file_name)
  3030. return FOPEN(wt_style.null_file_name,iomode);
  3031.  
  3032. if(*iomode=='r'&&STRCMP(file_name,"stdin")==0)
  3033. return stdin;
  3034. else if(*iomode=='w'&&STRCMP(file_name,"stdout")==0)
  3035. return stdout;
  3036.  
  3037. /* If there's no path, we just try to look in the present directory. */
  3038. if(!(path&&*path))
  3039. return x0open(file_name,extensions,iomode);
  3040.  
  3041. prefix_end_str[0]= prefix_end_char;
  3042. prefix_end_str[1]= '\0';
  3043.  
  3044. /* Hunt through the path. */
  3045. while((p1= (outer_char HUGE*)STRCHR(path,':'))!=NULL)
  3046. {
  3047. *p1= '\0';
  3048. STRCPY(total_name,path);
  3049. *p1= ':';
  3050. if(*(p1-1)!=prefix_end_char)
  3051. STRCAT(total_name,prefix_end_str);
  3052. STRCAT(total_name,file_name);
  3053. if((file_ptr= x0open(total_name,extensions,iomode))!=NULL)
  3054. return file_ptr;
  3055. path= p1+1;
  3056. }
  3057.  
  3058. return NULL;/* Couldn't open any file. */
  3059. }
  3060.  
  3061.  
  3062.  
  3063. FILE*
  3064. x0open FCN((file_name,extensions,iomode))
  3065. outer_char*file_name C0("")
  3066. SEQUENCES*extensions C0("")
  3067. CONST outer_char*iomode C1("")
  3068. {
  3069. int k;
  3070.  
  3071. /* If it has a dot in it, it's always interpreted literally.  If it didn't \
  3072. have a dot, then if the `\.{-e}'~option isn't in effect it will already \
  3073. have had the `\.{.web}' extension added to it, so it will now have a dot. \
  3074. (So presumably the last option of the \&{if} is redundant?) */
  3075. if(STRCHR(file_name,wt_style.ext_delimiter)!=NULL||!try_extensions)
  3076. return FOPEN(file_name,iomode);
  3077.  
  3078. /* At this point, the file name didn't have a dot and the `\.{-e}'~option \
  3079. is in effect.  Make trial file names from the list of extensions and try to \
  3080. open them one at a time until one matches. */
  3081. for(k= 0;k<extensions->n;k++)
  3082. {
  3083. outer_char full_name[MAX_FILE_NAME_LENGTH];
  3084. FILE*file_ptr;
  3085.  
  3086. if(
  3087. nsprintf(full_name,OC("%s%c%s"),3,file_name,wt_style.ext_delimiter,extensions->string[k])>=
  3088. MAX_FILE_NAME_LENGTH)OVERFLW("Extended file name","");
  3089.  
  3090. file_ptr= FOPEN(full_name,iomode);
  3091.  
  3092. if(file_ptr)
  3093. {
  3094. STRCPY(file_name,full_name);/* If we don't do this, the \
  3095. information messages aren't as informative as they could be. */
  3096. return file_ptr;/* Opened a file successfully. */
  3097. }
  3098. }
  3099.  
  3100. return NULL;/* Failed to open the file. */
  3101. }
  3102.  
  3103.  
  3104.  
  3105. boolean
  3106. get_line(VOID)
  3107. {
  3108. if(return_toggle)
  3109.  
  3110. {
  3111. return_toggle= NO;
  3112. if(popped&&no_more_input){input_has_ended= YES;return NO;}
  3113. STRNCPY(cur_buffer,stored_line,stored_line_length);
  3114. FREE_MEM(stored_line,"stored_line",stored_line_length,ASCII);
  3115. limit= cur_buffer+stored_line_length;
  3116. *limit= 040;
  3117. if(popped)
  3118. {
  3119. popped= NO;
  3120. goto popped_stack;
  3121. }
  3122. else if(toggling){goto push_stack;}
  3123. else goto process_line;
  3124. }
  3125.  
  3126.  
  3127.  
  3128. restart:
  3129. if(changing)
  3130. chngd_module[module_count]= YES;
  3131. else
  3132.  
  3133. {
  3134. popped= NO;
  3135.  
  3136. if(cur_prms.web->Line==0)
  3137. if(ignored_cmnts())goto fin_read;
  3138. else goto pop_or_quit;
  3139.  
  3140. while(!input_ln(INPUT_FILE))
  3141. {/* pop the stack or quit */
  3142. pop_or_quit:
  3143. prn_where= YES;
  3144.  
  3145. if(incl_depth==WEB_FILE){input_has_ended= YES;break;}
  3146. else
  3147. {/* Tidy up the include level we're about to leave. */
  3148. if(cur_prms.web->File!=prms[incl_depth-1].web.File)
  3149. {FCLOSE(cur_prms.web->File);}
  3150.  
  3151. if(cur_prms.change->File!=prms[incl_depth-1].change.File)
  3152. {FCLOSE(cur_prms.change->File);}
  3153. else prms[incl_depth-1].change= *cur_prms.change;
  3154.  
  3155. cur0_prms->File= NULL;
  3156. CLR_PRINTF(include_file,(")"));/* Tell the terminal we're \
  3157. finished with this web input file. */
  3158.  
  3159. /* Pop the stack here. */
  3160. incl_depth--;
  3161. cur_prms.web= &prms[incl_depth].web;
  3162. cur_prms.change= &prms[incl_depth].change;
  3163.  
  3164. if(incl_depth==WEB_FILE&&toggle_includes&&toggling)
  3165. {
  3166. toggling= NO;
  3167. return_toggle= YES;
  3168. }
  3169.  
  3170. STRCPY(this_include_file,(incl_depth==WEB_FILE)?
  3171. (CONST outer_char*)"":cur_file_name);
  3172.  
  3173. }
  3174. }
  3175.  
  3176. fin_read:
  3177. if(return_toggle)
  3178. {
  3179. no_more_input= input_has_ended;
  3180. input_has_ended= NO;
  3181. popped= YES;
  3182.  
  3183. {
  3184. return_toggle= YES;
  3185. stored_line_length= PTR_DIFF(size_t,limit,cur_buffer);
  3186. stored_line= GET_MEM("stored_line",stored_line_length+1,ASCII);/* We \
  3187.     allocate one extra so we don't have to handle the special case of a \
  3188.     zero-length line, for which |FREE_MEM| would complain. */
  3189. STRNCPY(stored_line,cur_buffer,stored_line_length);
  3190. loc= limit= cur_buffer;
  3191. *limit++= 0100;*limit++= '\001';*limit= 040;
  3192. return YES;
  3193. }
  3194.  
  3195.  
  3196. }
  3197.  
  3198. popped_stack:
  3199. if(!input_has_ended)
  3200. if(limit==change_limit-change_buffer+cur_buffer)
  3201. if(cur_buffer[0]==change_buffer[0])
  3202. if(change_limit>change_buffer)chk_change();
  3203. }
  3204.  
  3205. ;
  3206.  
  3207. if(changing)
  3208. {
  3209.  
  3210. {
  3211. if(!input_ln(CHANGE_FILE))
  3212. {
  3213.  
  3214. err0_print(ERR_C,OC("Change file ended without @z"),0);
  3215.  
  3216. cur_buffer[0]= 0100;cur_buffer[1]= 0172;limit= cur_buffer+2;
  3217. }
  3218.  
  3219. if(limit>cur_buffer+1)/* check if the change has ended */
  3220. if(cur_buffer[0]==0100)
  3221. {
  3222.  
  3223.  
  3224. if((cur_buffer[1]>=0130&&cur_buffer[1]<=0132)||cur_buffer[1]==0111)
  3225. cur_buffer[1]+= 0172-0132;
  3226.  
  3227. ;
  3228.  
  3229.  
  3230. if(cur_buffer[1]==0151)
  3231. {
  3232. loc= cur_buffer+2;
  3233.  
  3234. err0_print(ERR_C,OC("Sorry, no includes allowed in change file"),0);
  3235.  
  3236. }
  3237.  
  3238. ;
  3239.  
  3240. if(cur_buffer[1]==0170||cur_buffer[1]==0171)
  3241. {
  3242. loc= cur_buffer+2;
  3243. err0_print(ERR_C,OC("Where is the matching @z?"),0);
  3244.  
  3245. }
  3246. else if(cur_buffer[1]==0172)
  3247. {
  3248. prime_the_change_buffer();prn_where= YES;
  3249. }
  3250. }
  3251. }
  3252.  
  3253. ;
  3254.  
  3255. if(!changing)
  3256. {
  3257. chngd_module[module_count]= YES;goto restart;
  3258. }
  3259. }
  3260.  
  3261. process_line:
  3262. loc= cur_buffer;*limit= 040;
  3263.  
  3264. if(return_toggle)
  3265.  
  3266. {
  3267. return_toggle= YES;
  3268. stored_line_length= PTR_DIFF(size_t,limit,cur_buffer);
  3269. stored_line= GET_MEM("stored_line",stored_line_length+1,ASCII);/* We \
  3270.     allocate one extra so we don't have to handle the special case of a \
  3271.     zero-length line, for which |FREE_MEM| would complain. */
  3272. STRNCPY(stored_line,cur_buffer,stored_line_length);
  3273. loc= limit= cur_buffer;
  3274. *limit++= 0100;*limit++= '\001';*limit= 040;
  3275. return YES;
  3276. }
  3277.  
  3278.  
  3279.  
  3280. if(*cur_buffer==0100)
  3281. switch(*(cur_buffer+1))
  3282. {
  3283. case 0151:
  3284. case 0111:
  3285.  
  3286.  
  3287. if(*(cur_buffer+1)==0111&&(skip_includes||
  3288. (program==weave&&toggle_includes&&CUR_FILE==WEB_FILE)))
  3289. {
  3290. if(skip_includes)
  3291. {
  3292. loc= limit+1;/* Turn whole line into null. */
  3293. goto restart;
  3294. }
  3295. else if(toggle_includes&&CUR_FILE==WEB_FILE)
  3296. {
  3297. toggling= YES;
  3298.  
  3299. {
  3300. return_toggle= YES;
  3301. stored_line_length= PTR_DIFF(size_t,limit,cur_buffer);
  3302. stored_line= GET_MEM("stored_line",stored_line_length+1,ASCII);/* We \
  3303.     allocate one extra so we don't have to handle the special case of a \
  3304.     zero-length line, for which |FREE_MEM| would complain. */
  3305. STRNCPY(stored_line,cur_buffer,stored_line_length);
  3306. loc= limit= cur_buffer;
  3307. *limit++= 0100;*limit++= '\001';*limit= 040;
  3308. return YES;
  3309. }
  3310.  
  3311.  
  3312. }
  3313. }
  3314. else
  3315. {
  3316. boolean found_include;
  3317.  
  3318.  
  3319. push_stack:
  3320. loc= cur_buffer+2;/* Position after \.{@i}. */
  3321.  
  3322. if(++incl_depth>=(int)max_include_depth)
  3323. {
  3324. incl_depth--;
  3325.  
  3326. err0_print(ERR_C,OC("Too many nested includes; %d allowed.  \
  3327. Increase with `-yid'."),1,max_include_depth);
  3328.  
  3329. goto restart;
  3330. }
  3331.  
  3332. /* Look for the name of a \WEB\ file to include. */
  3333. if(!(found_include= get_fname(cur_file_name)))
  3334.  
  3335. err0_print(ERR_C,OC("Include file name not given"),0);
  3336.  
  3337. else
  3338. {/* Found a \WEB\ file name; now look for change file name. */
  3339. if(skip_ifiles)
  3340.  
  3341. {
  3342. int j;
  3343.  
  3344. for(j= 0;j<num_ifiles;j++)
  3345. if(STRCMP(ifiles[j],cur_file_name)==0)
  3346. {
  3347. incl_depth--;
  3348. goto restart;
  3349. }
  3350.  
  3351. if(num_ifiles==(int)max_ifiles)
  3352. OVERFLW("unique include file names","if");
  3353.  
  3354. if(phase==1)
  3355. {
  3356. ifiles[num_ifiles]= GET_MEM("ifile",STRLEN(cur_file_name)+1,outer_char);
  3357. STRCPY(ifiles[num_ifiles],cur_file_name);
  3358. }
  3359.  
  3360. num_ifiles++;
  3361. }
  3362.  
  3363.  
  3364.  
  3365. if(!get_fname(change_file_name))
  3366. {/* No change file name specified; obtain it from the \
  3367. last level. */
  3368. INPUT_PRMS*p_lower= &prms[incl_depth-1];
  3369. INPUT_PRMS0*p0_lower= &p_lower->change;
  3370.  
  3371. STRCPY(change_file_name,p0_lower->File_name);
  3372. change_file= p0_lower->File;
  3373. change_params= p_lower->input_params;
  3374. }
  3375. }
  3376.  
  3377. if(found_include)
  3378. {
  3379. if(ini_input_prms(CUR_FILE,incl.list,DONT_ABORT_ON_ERROR))
  3380. {
  3381. if(cur_prms.change->File!=prms[incl_depth-1].change.File)
  3382.  
  3383. {
  3384. cur0_prms= cur_prms.change;
  3385. changing= YES;
  3386. change_params= change_params0;/* Reset to default values. */
  3387. prime_the_change_buffer();
  3388.  
  3389.  
  3390. limit= cur_buffer;loc= cur_buffer+1;cur_buffer[0]= 040
  3391.  
  3392. ;
  3393. }
  3394.  
  3395. /* New change file. */
  3396. else*cur_prms.change= prms[incl_depth-1].change;
  3397. /* Still using the old change file. */
  3398.  
  3399. cur_line= 0;
  3400. prn_where= YES;
  3401. CLR_PRINTF(include_file,(" (%s",(char*)cur_file_name));
  3402. /* Tell the terminal where we're reading from. */
  3403. }
  3404. else
  3405. {/* Failed to open include file. */
  3406. incl_depth--;
  3407. }
  3408. }
  3409.  
  3410. goto restart;
  3411. }
  3412.  
  3413.  
  3414.  
  3415.  
  3416. break;
  3417. }
  3418.  
  3419. return(boolean)(!input_has_ended);
  3420. }
  3421.  
  3422.  
  3423.  
  3424. boolean
  3425. get_fname FCN((file_name))
  3426. outer_char HUGE*file_name C1("")
  3427. {
  3428. ASCII HUGE*j;
  3429. outer_char HUGE*k;
  3430.  
  3431. skip_white:
  3432.  
  3433. /* Skip over leading white space and optional quotes. */
  3434. while(loc<=limit&&(*loc==040||*loc==011||*loc==042))loc++;
  3435.  
  3436. /* If we've hit the end of the buffer, we're done, and we didn't find \
  3437. anything. */
  3438. if(loc>=limit)return NO;
  3439.  
  3440.  
  3441. {
  3442. if(*loc==057)
  3443. {
  3444. if(*(loc+1)==057)
  3445. {/* Short comment */
  3446. loc= limit+1;
  3447. return NO;
  3448. }
  3449.  
  3450. if(*(loc+1)==052)
  3451. {/* Long comment */
  3452. for(loc+= 2;loc<=limit;loc++)
  3453. if(*loc==052&&*(loc+1)==057)
  3454. {
  3455. loc+= 2;
  3456. goto skip_white;
  3457. }
  3458.  
  3459.  
  3460. err0_print(ERR_C,OC("Can't continue comments on @i lines"),0);
  3461. }
  3462. }
  3463. }
  3464.  
  3465.  
  3466.  
  3467. k= file_name;j= loc;
  3468.  
  3469. /* Terminate scan by white space or quotes. */
  3470. while(*loc!=040&&*loc!=011&&*loc!=042)*k++= XCHR(*loc++);
  3471. TERMINATE(k,0);
  3472.  
  3473. /* On certain systems, underscores aren't allowed in file names. */
  3474.  
  3475. add_prefix(file_name);/* Attach a directory prefix. */
  3476.  
  3477. return YES;
  3478. }
  3479.  
  3480.  
  3481.  
  3482. SRTN
  3483. add_prefix FCN((file_name))
  3484. outer_char HUGE*file_name C1("")
  3485. {
  3486. outer_char temp[MAX_FILE_NAME_LENGTH];
  3487.  
  3488. xpnd_file_name(file_name);/* Expand possible environmental prefix. */
  3489.  
  3490. if(*wbprefix&&STRRCHR(file_name,prefix_end_char)==NULL)
  3491. {
  3492. if(
  3493. nsprintf(temp,OC("%s%s"),2,wbprefix,file_name)>=
  3494. MAX_FILE_NAME_LENGTH)OVERFLW("Path/file_name","");
  3495.  
  3496. STRCPY(file_name,temp);
  3497. }
  3498. }
  3499.  
  3500.  
  3501.  
  3502. SRTN
  3503. xpnd_file_name FCN((name))
  3504. outer_char HUGE*name C1("")
  3505. {
  3506. outer_char temp[MAX_FILE_NAME_LENGTH],env_prefix[MAX_FILE_NAME_LENGTH];
  3507. outer_char*pc,*px,*qx;
  3508. CONST char*separator;
  3509. int n;
  3510. boolean expanded;
  3511.  
  3512. #ifdef vms
  3513. return;/* VAX/VMS does its own expansions of logical names. */
  3514. #else
  3515.  
  3516. #if !HAVE_GETENV
  3517.  
  3518. err0_print(ERR_C,OC("Sorry, this machine doesn't support environment variables"),0);
  3519. return;
  3520. #else
  3521.  
  3522. /* Is there a logical name prefix? */
  3523. if((pc= OC(STRCHR(name,':')))==NULL)return;
  3524.  
  3525. /* Isolate the prefix. */
  3526. STRNCPY(env_prefix,name,n= PTR_DIFF(int,pc,name));
  3527. TERMINATE(env_prefix,n);
  3528.  
  3529. /* Recursively expand the prefix. |px|~will have the last non-null name. */
  3530. expanded= NO;
  3531. for(px= env_prefix;px;px= qx)
  3532. {
  3533. if((qx= GETENV(px))==NULL)break;
  3534. if(STRCMP(qx,env_prefix)==0)
  3535. {
  3536.  
  3537. err0_print(ERR_C,OC("Infinite recursion in definition of \
  3538. environmental variable \"%s\""),1,px= env_prefix);
  3539. expanded= NO;
  3540. break;
  3541. }
  3542. expanded= YES;/* At least one expansion of the logical name was \
  3543. made. */
  3544. }
  3545.  
  3546. /* If the prefix wasn't expandable, or if it turned into an infinite \
  3547. recursion, do nothing. */
  3548. if(!expanded)return;
  3549.  
  3550. /* Otherwise, |px|~has the last expansion of the name. */
  3551. separator= 
  3552. #ifdef ibmpc
  3553. "\\"
  3554. #else
  3555. "/"
  3556. #endif /* |ibmpc| */
  3557. ;
  3558. if(
  3559. nsprintf(temp,OC("%s%s%s"),3,px,separator,pc+1)>=
  3560. MAX_FILE_NAME_LENGTH)
  3561. OVERFLW("Expandable file name","");
  3562. STRCPY(name,temp);
  3563.  
  3564. #endif /* |HAVE_GETENV| */
  3565. #endif /* |vms| */
  3566. }
  3567.  
  3568.  
  3569.  
  3570. boolean
  3571. ignored_cmnts(VOID)
  3572. {
  3573. boolean limbo_material;
  3574.  
  3575. /* Read the first line of file. */
  3576. if(!input_ln(INPUT_FILE))return NO;
  3577.  
  3578. /* Check for possible limbo material.     If so, skip all lines up to \
  3579. an~`\.{@x}'. */
  3580. limbo_material= BOOLEAN(cur_buffer[0]==0100&&cur_buffer[1]==0172);
  3581. if(limbo_material)
  3582. do
  3583. {
  3584. if(!input_ln(INPUT_FILE))
  3585. {
  3586. CLR_PRINTF(warning,("\n! File ended during \
  3587. skip_limbo.  Limbo material that begins with @z must be terminated by \
  3588. @x."));
  3589. return NO;
  3590. }
  3591. }
  3592. while(!(cur_buffer[0]==0100&&cur_buffer[1]==0170));
  3593.  
  3594. /* If there was limbo material, at this point the line beginning \
  3595. with~`\.{@x}' is in the buffer.  The next operation is to read another \
  3596. line, which starts the proper part of the include file.  If there was no \
  3597. limbo material, the first line of the file is already in the buffer. Thus, \
  3598. after the following operation we'll always have the first proper line of \
  3599. the file in the buffer. */
  3600. if(limbo_material&&!input_ln(INPUT_FILE))return NO;
  3601.  
  3602. return YES;/* Successfully skipped comments. */
  3603. }
  3604.  
  3605.  
  3606.  
  3607. SRTN
  3608. chk_complete(VOID)
  3609. {
  3610. if(change_limit!=NULL)
  3611. {/* |changing| is |NO| */
  3612. STRNCPY(cur_buffer,change_buffer,
  3613. PTR_DIFF(size_t,change_limit,change_buffer)+1);
  3614. loc= limit= PTR_DIFF(size_t,change_limit,change_buffer)+cur_buffer;
  3615. changing= YES;
  3616.  
  3617. err0_print(ERR_C,OC("Change file entry did not match"),0);
  3618.  
  3619. }
  3620. }
  3621.  
  3622.  
  3623.  
  3624. void HUGE*
  3625. get_mem0 FCN((why,nunits,nsize))
  3626. CONST outer_char why[]C0("Reason for request")
  3627. BUF_SIZE nunits C0("Number of units to allocate.")
  3628. size_t nsize C1("Size of each unit.")
  3629. {
  3630. void HUGE*p;/* With certain compilers such as the |SGI|, |void| is \
  3631.         translated into |char|; see \.{proto.hweb}. */
  3632. BUF_SIZE nbytes;
  3633.  
  3634. if(nunits==0)return NULL;/* Should this ever happen? */
  3635. if(nsize==0)CONFUSION("get_mem0","Nsize = 0 requested");
  3636.  
  3637. #if !NON_ANSI_CALLOC
  3638. /* For ANSI, the prototype for |calloc| is |void *calloc(size_t,size_t)|. */
  3639. if(nunits>MAX_SIZE_T)
  3640. {
  3641.  
  3642. err0_print(ERR_C,OC("get_mem0: Can't request %lu units; used max of %lu"),2,nunits,MAX_SIZE_T);
  3643. nunits= MAX_SIZE_T;
  3644. }
  3645. #endif /* |ANSI_CALLOC| */
  3646.  
  3647. if((p= (void HUGE*)CALLOC(nunits,nsize))==NULL)
  3648. {
  3649. char temp[250];
  3650.  
  3651. sprintf(temp,"\n!!! NO MORE MEMORY (\"%s\")!!! \
  3652. [Requesting %lu unit(s) of size %lu byte(s); allocated %lu bytes so far.]  \
  3653. Try using the -y option to reduce the sizes of internal tables.",
  3654. (char*)why,nunits,(BUF_SIZE)nsize,total_mem);
  3655. FREE(byte_mem);/* Kludge to try to make it go out gracefully. */
  3656. FATAL(C,temp,"");
  3657. }
  3658.  
  3659. /* Keep track of total allocation. */
  3660. nbytes= nunits*nsize;
  3661. total_mem+= nbytes;
  3662. max_mem= MAX(max_mem,total_mem);
  3663.  
  3664. #ifdef mac
  3665. lmemset(p,0,nbytes);/* For |lmalloc|, must zero explicitly. */
  3666. #endif
  3667.  
  3668. if(show_mem&&nbytes>=show_size)
  3669. show_alloc('+',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);
  3670.  
  3671. return p;/* The allocated memory area. */
  3672. }
  3673.  
  3674.  
  3675.  
  3676. SRTN
  3677. show_alloc FCN((c,why,nunits,nsize,nbytes,p,total_mem))
  3678. outer_char c C0("Either plus or minus")
  3679. CONST outer_char why[]C0("Reason for request")
  3680. BUF_SIZE nunits C0("Number of units")
  3681. BUF_SIZE nsize C0("Size of each unit.")
  3682. BUF_SIZE nbytes C0("Bytes allocated")
  3683. void HUGE*p C0("Start of allocated area")
  3684. BUF_SIZE total_mem C1("Total bytes currently allocated")
  3685. {
  3686. printf("\"%s\": %c(%lu x %lu) = %c%lu ",
  3687. (char*)why,c,nunits,nsize,c,nbytes);
  3688. ptr_range(p,nbytes);
  3689. printf("(%lu total)\n",total_mem);
  3690. }
  3691.  
  3692.  
  3693.  
  3694. SRTN
  3695. ptr_range FCN((p,nbytes))
  3696. void HUGE*p C0("Start of the allocated space.")
  3697. BUF_SIZE nbytes C1("Length of the allocation")
  3698. {
  3699. static char ptr_string[]= 
  3700. #ifdef ibmpc
  3701. PTR_BASE
  3702. #else
  3703. ""
  3704. #endif
  3705. ;
  3706.  
  3707. printf(ptr_string,p,(char HUGE*)p+nbytes);
  3708. }
  3709.  
  3710.  
  3711.  
  3712. SRTN
  3713. free_mem0 FCN((p,why,nunits,nsize))
  3714. void HUGE*p C0("Pointer to deallocate")
  3715. CONST outer_char why[]C0("Reason for request")
  3716. BUF_SIZE nunits C0("Number of units to deallocate.")
  3717. size_t nsize C1("Size of each unit.")
  3718. {
  3719. BUF_SIZE nbytes;
  3720.  
  3721. /* If things are working correctly, |p|~should have been previously \
  3722. allocated. */
  3723. if(p==NULL)CONFUSION("free_mem0","Attempting to deallocate NULL pointer");
  3724.  
  3725. /* Keep track of total allocation. */
  3726. nbytes= nunits*nsize;
  3727. total_mem-= nbytes;
  3728.  
  3729. if(show_mem&&nbytes>=show_size)
  3730. show_alloc('-',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);
  3731.  
  3732. FREE(p);
  3733. }
  3734.  
  3735.  
  3736.  
  3737. MEM HUGE*
  3738. msearch FCN((abbrev,nunits))
  3739. CONST outer_char abbrev[]C0("Abbreviation for desired object.")
  3740. BUF_SIZE nunits C1("Value.")
  3741. {
  3742. MEM HUGE*m;
  3743.  
  3744. for(m= mem;*m->abbrev;m++)
  3745. if(STRCMP(m->abbrev,abbrev)==0)
  3746. {
  3747. if(nunits==0L)return m;/* Special case: just find it. */
  3748.  
  3749. if(nunits<m->min)
  3750. {
  3751. CLR_PRINTF(warning,
  3752. ("! Warning (msearch:%s): nunits (%lu) < min (%lu); min used.\n",
  3753. (char*)abbrev,nunits,m->min));
  3754. mark_harmless;
  3755. nunits= m->min;
  3756. }
  3757. else if(nunits>m->max)
  3758. {
  3759. CLR_PRINTF(warning,
  3760. ("! Warning (msearch:%s): nunits (%lu) > max (%lu); max used\n",
  3761. (char*)abbrev,nunits,m->max));
  3762. mark_harmless;
  3763. nunits= m->max;
  3764. }
  3765.  
  3766. m->nunits= nunits;/* Override the default value. */
  3767. return m;
  3768. }
  3769.  
  3770. CLR_PRINTF(warning,
  3771. ("! Invalid alloc abbreviation \"%s[%lu]\"\n",(char*)abbrev,nunits));
  3772. mark_harmless;
  3773. return m;
  3774. }
  3775.  
  3776.  
  3777.  
  3778. void HUGE*
  3779. alloc FCN((abbrev,pnunits,nsize,dn))
  3780. CONST outer_char abbrev[]C0("Abbreviation for desired object.")
  3781. BUF_SIZE HUGE*pnunits C0("Pointer to returned \# of units.")
  3782. size_t nsize C0("Size of object.")
  3783. int dn C1("Incremental number of units to allocate.")
  3784. {
  3785. MEM HUGE*m= find_abbrev(abbrev);
  3786.  
  3787. *pnunits= m->nunits;
  3788.  
  3789. /* |dn| is used as a flag; if it's negative, we just obtain the number of \
  3790. units. */
  3791. if(dn<0)
  3792. return NULL;
  3793. else
  3794. return get_mem0(abbrev,(*pnunits)+dn,nsize);
  3795. }
  3796.  
  3797.  
  3798. MEM HUGE*find_abbrev FCN((abbrev))
  3799. CONST outer_char abbrev[]C1("")
  3800. {
  3801. MEM HUGE*m;
  3802. outer_char temp[100];
  3803.  
  3804. for(m= mem;*m->abbrev;m++)
  3805. if(STRCMP(m->abbrev,abbrev)==0)return m;
  3806.  
  3807.  
  3808. if(
  3809. nsprintf(temp,OC("Bad alloc abbreviation \"%s\""),1,abbrev)>=(int)(100))OVERFLW("temp","");
  3810. CONFUSION("find_abbrev",temp);
  3811. return NULL;
  3812. }
  3813.  
  3814.  
  3815. #ifdef mcc
  3816.  
  3817. void HUGE*
  3818. hrealloc FCN((old_ptr,new_size,old_size))
  3819. void HUGE*old_ptr C0("Old buf previously allocated with |halloc|.")
  3820. BUF_SIZE new_size C0("New size in bytes.")
  3821. BUF_SIZE old_size C1("Old size in bytes.")
  3822. {
  3823. void HUGE*new_ptr;
  3824. BUF_SIZE num_to_copy;
  3825. size_t ncopied;
  3826.  
  3827. new_ptr= GET_MEM("hrealloc",new_size,char);
  3828.  
  3829. if(new_ptr==NULL)
  3830. return NULL;
  3831.  
  3832. num_to_copy= MIN(old_size,new_size);
  3833. ncopied= (size_t)num_to_copy;
  3834.  
  3835. if((BUF_SIZE)ncopied!=num_to_copy)
  3836. CONFUSION("hrealloc","trying to copy more than size_t");
  3837.  
  3838. memcpy(new_ptr,old_ptr,ncopied);
  3839.  
  3840. FREE_MEM(old_ptr,"old_ptr",old_size,char);
  3841.  
  3842. return new_ptr;
  3843. }
  3844.  
  3845. #endif /* |mcc| */
  3846.  
  3847.  
  3848.  
  3849. unsigned
  3850. prn_id FCN((np))
  3851. name_pointer np C1("")
  3852. {
  3853. ASCII_write(*np->byte_start==BP_MARKER?
  3854. ((BP*)np->byte_start)->Root->id:np->byte_start,Length(np));
  3855.  
  3856. return PTR_DIFF(unsigned,np,name_dir);
  3857. }
  3858.  
  3859. int
  3860. Length FCN((np))
  3861. name_pointer np C1("")
  3862. {
  3863. int n;
  3864. BP HUGE*bp;
  3865. TRUNC HUGE*s;
  3866. CONST ASCII HUGE*p0;
  3867. CONST ASCII HUGE*p1;
  3868.  
  3869. p0= np->byte_start;
  3870. bp= (BP*)p0;
  3871.  
  3872. if(*(char*)bp==BP_MARKER)
  3873. {
  3874. s= bp->Root;
  3875. n= PTR_DIFF(int,s->id_end,s->id);
  3876. }
  3877. else
  3878. {
  3879. p1= (np+1)->byte_start;
  3880. PROPER_END(p1);
  3881. n= PTR_DIFF(int,p1,p0);
  3882. }
  3883.  
  3884. return n;
  3885. }
  3886.  
  3887.  
  3888.  
  3889. name_pointer
  3890. id_lookup FCN((first,last,t))
  3891. CONST ASCII HUGE*first C0("First character of string.")
  3892. CONST ASCII HUGE*last C0("last character of string plus one.")
  3893. eight_bits t C1("The |ilk|; used by \.{WEAVE} only.")
  3894. {
  3895. CONST ASCII HUGE*i= first;/* position in |cur_buffer| */
  3896. int h;/* hash code */
  3897. int l;/* length of the given identifier */
  3898. name_pointer p;/* where the identifier is being sought */
  3899. WORD_TYPE word_type0= ORDINARY_ID;
  3900.  
  3901. if(last==NULL)
  3902. {
  3903. word_type0= word_type;
  3904.  
  3905. for(last= first;*last!='\0';last++)
  3906. ;/* Find end of identifier. */
  3907. }
  3908.  
  3909. l= PTR_DIFF(int,last,first);/* compute the length */
  3910.  
  3911.  
  3912. h= *i;
  3913.  
  3914. while(++i<last)h= (h+h+*i)%hash_size;
  3915.  
  3916. ;
  3917.  
  3918. p= hash[h];
  3919.  
  3920. while(p&&!names_match(p,first,l,t))p= p->link;
  3921.  
  3922. if(p==NULL)
  3923. {
  3924. p= name_ptr;/* the current identifier is new */
  3925. p->link= hash[h];hash[h]= p;/* insert |p| at beginning of hash \
  3926.                         list */
  3927. }
  3928.  
  3929. ;
  3930.  
  3931. if(p==name_ptr)
  3932.  
  3933. {
  3934. if(byte_ptr+l>byte_end)OVERFLW("bytes","b");
  3935. if(name_ptr>=name_end)OVERFLW("names","n");
  3936.  
  3937. STRNCPY(byte_ptr,first,l);
  3938. (++name_ptr)->byte_start= byte_ptr+= l;
  3939.  
  3940. if(program==weave)
  3941. ini_p(p,t);
  3942. }
  3943.  
  3944. ;
  3945.  
  3946. if(!(p->Language&(boolean)language))
  3947. p->ilk= t;
  3948.  
  3949. p->Language|= (boolean)language;/* Record language usage. */
  3950.  
  3951. switch(word_type0)
  3952. {
  3953. case RESERVED_WD:
  3954. p->reserved_word|= (boolean)language;
  3955. break;
  3956.  
  3957. case INTRINSIC_FCN:
  3958. p->intrinsic_word|= (boolean)language;
  3959. break;
  3960.  
  3961. case KEYWD:
  3962. p->keyword|= (boolean)language;
  3963. break;
  3964.  
  3965. default:;/* Avoids warning about unused |enum|. */
  3966. }
  3967.  
  3968. return p;
  3969. }
  3970.  
  3971.  
  3972.  
  3973. sixteen_bits
  3974. find_n FCN((n))
  3975. sixteen_bits n C1("")
  3976. {
  3977. name_pointer np;
  3978. CONST ASCII HUGE*end;
  3979. outer_char HUGE*s;
  3980. size_t len;
  3981.  
  3982. np= name_dir+n;
  3983.  
  3984. if(np>=name_ptr)
  3985. {
  3986. printf("!! n = %u exceeds nmax = %u.\n",n,
  3987. PTR_DIFF(unsigned,name_ptr,name_dir)-1);
  3988. return 0;
  3989. }
  3990.  
  3991. PROPER_END(end);
  3992.  
  3993. len= PTR_DIFF(size_t,end,np->byte_start);/* Length of the $n$th identifier. */
  3994. s= GET_MEM("find_n",len+1,outer_char);/* Allocate temporary area. */
  3995.  
  3996. STRNCPY(s,np->byte_start,len);
  3997. TERMINATE(s,len);
  3998.  
  3999. /* Convert from |ASCII| to the outer world; print info about id. */
  4000. to_outer((ASCII HUGE*)s);
  4001. id_info(np,(long)n,(CONST outer_char*)s,NULL);
  4002. FREE_MEM(s,"find_n",len+1,outer_char);
  4003.  
  4004. return n;
  4005. }
  4006.  
  4007. sixteen_bits
  4008. find_s FCN((s))
  4009. CONST outer_char*s C1("")
  4010. {
  4011. int h,l;
  4012. name_pointer p;
  4013. ASCII HUGE*a;
  4014. CONST ASCII HUGE*first,HUGE*last;
  4015. CONST ASCII HUGE*i;
  4016. sixteen_bits n= 0;
  4017.  
  4018. l= STRLEN(s);
  4019. a= GET_MEM("find_s",l+1,ASCII);
  4020. STRCPY(a,s);
  4021. i= first= to_ASCII((outer_char*)a);
  4022. last= first+l;
  4023.  
  4024.  
  4025.  
  4026. h= *i;
  4027.  
  4028. while(++i<last)h= (h+h+*i)%hash_size;
  4029.  
  4030.  
  4031. p= hash[h];
  4032. while(p&&!(STRNCMP(first,p->byte_start,l)==0))p= p->link;
  4033.  
  4034. if(p==NULL)
  4035. {CLR_PRINTF(warning,("%cId \"%s\" is not in name_dir!\n",
  4036. beep(1),(char*)s));}
  4037. else
  4038. id_info(p,(long)(n= (sixteen_bits)(p-name_dir)),s,NULL);
  4039.  
  4040. FREE_MEM(a,"find_s",l+1,ASCII);
  4041.  
  4042. return n;
  4043. }
  4044.  
  4045.  
  4046.  
  4047.  
  4048. sixteen_bits
  4049. find_id FCN((a0,a1))
  4050. eight_bits a0 C0("")
  4051. eight_bits a1 C1("")
  4052. {
  4053. return find_n(IDENTIFIER(a0,a1));
  4054. }
  4055.  
  4056.  
  4057.  
  4058. SRTN
  4059. id_info FCN((np,n,s,prsrvd))
  4060. name_pointer np C0("")
  4061. long n C0("")
  4062. CONST outer_char*s C0("")
  4063. CONST RSRVD HUGE*prsrvd C1("")
  4064. {
  4065. if(n>=0)
  4066. printf(_Xx("Id %ld (0x%lx):"),n,n);
  4067.  
  4068. if(!prsrvd
  4069. ||(prsrvd->reserveds&&np->reserved_word)
  4070. ||(prsrvd->intrinsics&&np->intrinsic_word)
  4071. ||(prsrvd->keywords&&np->keyword))
  4072. printf(" \"%s\"\n",(char*)s);
  4073.  
  4074. if(!prsrvd)
  4075. pr_lan("Language ",np->Language);
  4076.  
  4077. if(!prsrvd||prsrvd->reserveds)
  4078. pr_lan("reserved ",np->reserved_word);
  4079.  
  4080. if(!prsrvd||prsrvd->intrinsics)
  4081. pr_lan("intrinsic",np->intrinsic_word);
  4082.  
  4083. if(!prsrvd||prsrvd->keywords)
  4084. pr_lan("keyword  ",np->keyword);
  4085. }
  4086.  
  4087.  
  4088. SRTN
  4089. pr_lan FCN((name,b))
  4090. CONST char*name C0("")
  4091. boolean b C1("")
  4092. {
  4093. unsigned k;
  4094. boolean first= YES;
  4095.  
  4096. if(b==0)return;
  4097.  
  4098. printf("   %s = { ",name);
  4099.  
  4100. for(k= 1;k<=256;k<<= 1)
  4101. if(k&b)
  4102. {
  4103. printf("%s%s",first?"":", ",
  4104. languages[lan_num((LANGUAGE)k)]);
  4105. first= NO;
  4106. }
  4107.  
  4108. if(first)printf("(none)");
  4109. printf(_Xx(" } (0x%x)\n"),b);
  4110. }
  4111.  
  4112.  
  4113.  
  4114. BUF_SIZE
  4115. prn_nd(VOID)
  4116. {
  4117. BUF_SIZE k,n= name_ptr-name_dir;
  4118.  
  4119. for(k= 0;k<n;k++)
  4120. {
  4121. printf("[%lu]:  ",k);
  4122. prn_id(name_dir+k);
  4123. putchar('\n');
  4124. }
  4125.  
  4126. return n;
  4127. }
  4128.  
  4129.  
  4130.  
  4131. name_pointer
  4132. mod_lookup FCN((k,l))
  4133. CONST ASCII HUGE*k C0("First character of name.")
  4134. CONST ASCII HUGE*l C1("Last character of name.")
  4135. {
  4136. LEXI c= GREATER;/* comparison between two names */
  4137. name_pointer p= root;/* current node of the search tree */
  4138. name_pointer q= name_dir;/* father of node |p| */
  4139.  
  4140. while(p)
  4141. {
  4142. c= web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);
  4143. q= p;
  4144.  
  4145. switch(c)
  4146. {
  4147. case LESS:p= p->llink;continue;
  4148. case GREATER:p= p->rlink;continue;
  4149. case EQUAL:return p;
  4150. default:
  4151. err0_print(ERR_C,OC("Incompatible section names"),0);
  4152. return NULL;
  4153.  
  4154. }
  4155. }
  4156.  
  4157. return install_node(q,c,k,PTR_DIFF(int,l,k)+1);
  4158. }
  4159.  
  4160.  
  4161.  
  4162. LEXI
  4163. web_strcmp FCN((j,j1,k,k1))/* fuller comparison than |strcmp| */
  4164. CONST ASCII HUGE*j C0("Beginning of first string.")
  4165. CONST ASCII HUGE*j1 C0("End of first string plus one.")
  4166. CONST ASCII HUGE*k C0("Beginning of second string.")
  4167. CONST ASCII HUGE*k1 C1("End of second string plus one.")
  4168. {
  4169. while(k<k1&&j<j1&&*j==*k)k++,j++;
  4170.  
  4171. if(k==k1)if(j==j1)return EQUAL;
  4172. else return EXTENSION;
  4173. else if(j==j1)return PREFIX;
  4174. else if(*j<*k)return LESS;
  4175. else return GREATER;
  4176. }
  4177.  
  4178.  
  4179.  
  4180. name_pointer
  4181. install_node FCN((parent,c,j,name_len))/* install a new node in the tree */
  4182. name_pointer parent C0("Parent of new node.")
  4183. int c C0("Right or left?")
  4184. CONST ASCII HUGE*j C0("Where replacement text starts.")
  4185. int name_len C1("length of replacement text.")
  4186. {
  4187. name_pointer node= name_ptr;/* new node */
  4188. if(byte_ptr+name_len>byte_end)OVERFLW("bytes","b");
  4189. if(name_ptr==name_end)OVERFLW("names","n");
  4190.  
  4191. if(c==LESS)parent->llink= node;else parent->rlink= node;
  4192.  
  4193. node->llink= node->rlink= NULL;
  4194. ini_node(node);
  4195. STRNCPY(byte_ptr,j,name_len);
  4196. (++name_ptr)->byte_start= byte_ptr+= name_len;
  4197. return node;
  4198. }
  4199.  
  4200.  
  4201.  
  4202. name_pointer
  4203. prefix_lookup FCN((k,l))/* finds module name given a prefix */
  4204. CONST ASCII HUGE*k C0("First char of prefix.")
  4205. CONST ASCII HUGE*l C1("Last char of prefix.")
  4206. {
  4207. LEXI c= GREATER;/* comparison between two names */
  4208. short count= 0;/* the number of hits */
  4209. name_pointer p= root;/* current node of the search tree */
  4210. name_pointer q= NULL;
  4211. /* another place to resume the search after one is done */
  4212. name_pointer r= NULL;/* extension found */
  4213. while(p){
  4214. c= web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);
  4215.  
  4216. switch(c){
  4217. case LESS:p= p->llink;break;
  4218. case GREATER:p= p->rlink;break;
  4219. default:r= p;count++;q= p->rlink;p= p->llink;
  4220. }
  4221.  
  4222. if(p==NULL){
  4223. p= q;q= NULL;
  4224. }
  4225. }
  4226. if(count==0)
  4227. err0_print(ERR_C,OC("Name does not match"),0);
  4228.  
  4229. else if(count>1)
  4230. err0_print(ERR_C,OC("Ambiguous prefix"),0);
  4231.  
  4232.  
  4233. return r;/* the result will be |NULL| if there was no match */
  4234. }
  4235.  
  4236.  
  4237.  
  4238. unsigned
  4239. find_prefix FCN((s))
  4240. outer_char s[]C1("")
  4241. {
  4242. name_pointer r;
  4243.  
  4244. to_ASCII(s);
  4245. r= prefix_lookup((ASCII HUGE*)s,(ASCII HUGE*)(s+STRLEN(s)));
  4246.  
  4247. return r?prn_id(r):0;
  4248. }
  4249.  
  4250.  
  4251.  
  4252. SRTN
  4253. err0_print FCN(VA_ALIST((err_origin,fmt,n VA_ARGS)))
  4254. VA_DCL(
  4255. ERR_ORIGIN err_origin C0("Where the error came from")
  4256. CONST outer_char*fmt C0("Format of error message.")
  4257. int n C2("Number of arguments to the string."))
  4258. {
  4259. VA_LIST(arg_ptr)
  4260. ASCII HUGE*k,HUGE*l;/* pointers into |cur_buffer| */
  4261. char temp[500];
  4262. boolean prn_input_buffer;
  4263. #if(NUM_VA_ARGS == 1)
  4264. ERR_ORIGIN err_origin;
  4265. CONST outer_char*fmt;
  4266. int n;
  4267. #endif
  4268.  
  4269. VA_START(arg_ptr,n);
  4270.  
  4271. #if(NUM_VA_ARGS == 1)
  4272. err_origin= va_arg(arg_ptr,ERR_ORIGIN);
  4273. fmt= va_arg(arg_ptr,outer_char*);
  4274. va_arg(arg_ptr,int);
  4275. #endif
  4276.  
  4277. prn_input_buffer= BOOLEAN(err_origin!=ERR_NULL);
  4278.  
  4279. if(prn_input_buffer&&err_origin!=ERR_S)putchar('\n');
  4280.  
  4281. set_color(RED);
  4282.  
  4283. if(prn_input_buffer)
  4284. {
  4285. sprintf(temp,"! (%s):  %s",origin_name[err_origin],(char*)fmt);
  4286. vprintf(temp,arg_ptr);
  4287. }
  4288. else
  4289. vprintf((char*)fmt,arg_ptr);
  4290.  
  4291. va_end(arg_ptr);
  4292.  
  4293. if(prn_input_buffer)
  4294. if(err_origin==ERR_S)
  4295.  
  4296. {
  4297. CONST outer_char HUGE*k,HUGE*l;
  4298. IN_STYLE boolean from_sprm;
  4299.  
  4300. printf(".  (l. %u of %s file ",s_line,"style");
  4301. CLR_PRINTF(in_file,("%s)\n",
  4302. from_sprm?"parameter buffer":(char*)style_file_name));
  4303.  
  4304. l= MIN(sloc,slimit);
  4305.  
  4306. for(k= sbuf;k<l;k++)
  4307. putchar(*k>127?' ':(*k=='\t'?' ':*k));
  4308. /* Print the characters already read. */
  4309.  
  4310. putchar('\n');/* Separate already read from not yet read. */
  4311.  
  4312. for(k= sbuf;k<l;k++)
  4313. putchar(' ');/* Space out the next line. */
  4314.  
  4315. for(k= l;k<slimit;k++)
  4316. putchar(*k>127?' ':*k);/* Print the part not yet read. */
  4317.  
  4318. putchar('\n');
  4319. }
  4320.  
  4321.  
  4322. else
  4323.  
  4324. {
  4325. outer_char last_char= fmt[STRLEN(fmt)-1];
  4326.  
  4327. if(*fmt&&last_char!='?'&&last_char!='!')
  4328. printf(".");/* Sometimes the third argument to |fatal| is empty, \
  4329.             so the period isn't necessary. */
  4330.  
  4331. if(cur0_prms)
  4332. {
  4333. if(changing)
  4334. {
  4335. printf(" (l. %u of %s file ",change_line,"change");
  4336. CLR_PRINTF(in_file,("%s)\n",(char*)change_file_name));
  4337. }
  4338. else if(incl_depth==WEB_FILE)
  4339. printf(" (l. %u)\n",cur_line);
  4340. else
  4341. {
  4342. printf(" (l. %u of %s file ",cur_line,"include");
  4343. CLR_PRINTF(in_file,("%s)\n",(char*)cur_file_name));
  4344. }
  4345.  
  4346. l= MIN(loc,limit);
  4347.  
  4348. if(l>cur_buffer&&cur_buffer!=NULL)
  4349. {
  4350. if((BUF_SIZE)(l-cur_buffer)>buf_size)
  4351. {
  4352. CLR_PRINTF(error,
  4353. ("! TROUBLE IN ERROR ROUTINE.  PLEASE REPORT THIS!\n"));
  4354. mark_error;
  4355.  
  4356. l= cur_buffer+MAX_ERR_BUF;
  4357. }
  4358.  
  4359. for(k= cur_buffer;k<l;k++)
  4360. if(*k==011)
  4361. putchar(' ');
  4362. else
  4363. putchar(*k>127?' ':XCHR(*k));
  4364. /* print the characters already read */
  4365.  
  4366. putchar('\n');/* Separate already read from not yet read. */
  4367.  
  4368. for(k= cur_buffer;k<l;k++)putchar(' ');/* Space out the next line. */
  4369. }
  4370.  
  4371. if(l!=NULL)
  4372. {
  4373. if((BUF_SIZE)(limit-l)>buf_size)
  4374. {
  4375. puts("! TROUBLE IN ERROR ROUTINE.  PLEASE REPORT THIS!");
  4376. l= limit-MAX_ERR_BUF;
  4377. }
  4378.  
  4379. for(k= l;k<limit;k++)
  4380. putchar(*k>127?' ':XCHR(*k));
  4381. /* print the part not yet read */
  4382. }
  4383. if(limit!=NULL)
  4384. if(*limit==0174)putchar('|');/* End of code text in module names. */
  4385.  
  4386. putchar(' ');/* To separate the message from future asterisks. */
  4387. err_happened= YES;
  4388. }
  4389. }
  4390.  
  4391.  
  4392.  
  4393. fflush(stdout);mark_error;
  4394.  
  4395. mfree();/* Free up any |mod_trans| allocations. */
  4396. }
  4397.  
  4398.  
  4399.  
  4400. int
  4401. fatal FCN((err_origin,s1,s2))
  4402. ERR_ORIGIN err_origin C0("Where the error came from")
  4403. CONST outer_char s1[]C0("Message 1.")
  4404. CONST outer_char s2[]C1("Message 2.")
  4405. {
  4406. printf("\n");
  4407. if(err_origin!=ERR_NULL)
  4408. {
  4409. CLR_PRINTF(fatal,("! (%s):  ",origin_name[err_origin]));
  4410. }
  4411. CLR_PRINTF(fatal,((char*)s1));err0_print(ERR_NULL,s2,0);
  4412. history= fatal_message;
  4413.  
  4414. return wrap_up();/* It never really returns, but the compiler doesn't \
  4415.             know that. */
  4416. }
  4417.  
  4418.  
  4419.  
  4420. int
  4421. confusion FCN((where,why))
  4422. CONST outer_char where[]C0("")
  4423. CONST outer_char why[]C1("What went wrong.")
  4424. {
  4425. outer_char temp[100];
  4426.  
  4427.  
  4428. if(
  4429. nsprintf(temp,OC("\n    At %s:  %s."),2,where,why)>=(int)(100))OVERFLW("temp","");
  4430.  
  4431. beep(3);
  4432.  
  4433. return FATAL(NULL,"\n!!! \
  4434. I'M CONFUSED; this shouldn't happen.  PLEASE REPORT THIS!!!  ",temp);
  4435. }
  4436.  
  4437.  
  4438.  
  4439.  
  4440. SRTN
  4441. overflow FCN((s,abbrev))
  4442. CONST outer_char s[]C0("Condition that caused overflow.")
  4443. CONST outer_char abbrev[]C1("Abbreviation for buffer.")
  4444. {
  4445. char temp[1000];
  4446. MEM HUGE*m;
  4447.  
  4448. if(*abbrev=='\0')
  4449. sprintf(temp,"%s contents too long.",(char*)s);
  4450. else
  4451. {
  4452. m= msearch(abbrev,0L);
  4453. sprintf(temp,"Too many %s: current number is %lu, absolute max is \
  4454. %lu.  Use command-line option \"-y%s...\" to override default.",
  4455. (char*)s,m->nunits,m->max,(char*)abbrev);
  4456. }
  4457.  
  4458. FATAL(NULL,"!! Sorry, CAPACITY EXCEEDED:  ",temp);
  4459. }
  4460.  
  4461.  
  4462.  
  4463.  
  4464. SRTN
  4465. new_sprm FCN((name,value))
  4466. CONST outer_char name[]C0("Name of parameter.")
  4467. int value C1("Integer value of parameters.")
  4468. {
  4469. char temp[100];
  4470.  
  4471. sprintf(temp,"Please increase style-file parameter `%s' from current value \
  4472. of %i;",name,value);
  4473. OVERFLW(temp,"");
  4474. }
  4475.  
  4476.  
  4477.  
  4478. #if(VMS)
  4479. #include stsdef /* Return codes. */
  4480. #endif /* |VMS| */
  4481.  
  4482. int
  4483. wrap_up()
  4484. {
  4485. putchar('\n');
  4486.  
  4487. #if TIMING
  4488. prn_time();
  4489. #endif /* |TIMING| */
  4490.  
  4491.  
  4492. {
  4493. CLR_PRINTF(info,("[%s:",program==tangle?"FTANGLE":"FWEAVE"));
  4494. printf("  ");
  4495.  
  4496. switch(history)
  4497. {
  4498. case spotless:
  4499. CLR_PRINTF(info,("No errors were found."));break;
  4500.  
  4501. case harmless_message:
  4502. CLR_PRINTF(warning,
  4503. ("%cDid you see the warning message(s) above?",beep(1)));
  4504. break;
  4505.  
  4506. case error_message:
  4507. CLR_PRINTF(error,
  4508. ("%cPardon me, but I think I spotted something wrong.",beep(1)));
  4509. break;
  4510.  
  4511. case fatal_message:
  4512. CLR_PRINTF(fatal,("%cThat was a fatal error, my friend.",beep(2)));
  4513. break;
  4514. }/* There are no other cases. */
  4515.  
  4516. CLR_PRINTF(info,("]\n"));
  4517. set_color(NORMAL);
  4518. }
  4519.  
  4520.  
  4521.  
  4522. {
  4523. if(cur_prms.web&&cur_prms.web->File)
  4524. fclose(cur_prms.web->File);
  4525.  
  4526. if(cur_prms.change&&cur_prms.change->File)
  4527. fclose(cur_prms.change->File);
  4528.  
  4529. cls_files();/* Do stuff specific to \FTANGLE\ or \FWEAVE. */
  4530. }
  4531.  
  4532.  
  4533.  
  4534. #if(VMS)
  4535. switch(history)
  4536. {
  4537. case spotless:exit(STS$K_SUCCESS|STS$M_INHIB_MSG);
  4538. case harmless_message:exit(STS$K_INFO|STS$M_INHIB_MSG);
  4539. case error_message:exit(STS$K_ERROR|STS$M_INHIB_MSG);
  4540. case fatal_message:exit(STS$K_SEVERE|STS$M_INHIB_MSG);
  4541. }
  4542. #else
  4543. switch(history)
  4544. {
  4545. case spotless:
  4546. case harmless_message:
  4547. exit(0);
  4548.  
  4549. default:
  4550. exit(1);
  4551. }
  4552. #endif /* |VMS| */
  4553.  
  4554. return-1;/* Never really does this. */
  4555. }
  4556.  
  4557.  
  4558.  
  4559. char
  4560. beep FCN((n))
  4561. int n C1("")
  4562. {
  4563. if(beeps)
  4564. {
  4565. for(--n;n>0;n--)
  4566. printf("\007");
  4567.  
  4568. return '\007';/* (Some compilers didn't understand \.{'\\a'}.) */
  4569. }
  4570. else
  4571. return '!';
  4572. }
  4573.  
  4574.  
  4575.  
  4576. SRTN
  4577. out_error FCN((fcn))
  4578. CONST outer_char fcn[]C1("")
  4579. {
  4580. FATAL(C,"!! Output error (no more quota?): ",fcn);
  4581. }
  4582.  
  4583.  
  4584.  
  4585.  
  4586. SRTN
  4587. scan_args(VOID)
  4588. {
  4589. outer_char wbflnm[MAX_FILE_NAME_LENGTH];
  4590.  
  4591. /* Build the command line in a buffer. */
  4592. cmd_ln_buf= cmd_line(argc,argv);
  4593.  
  4594. /* Add the arguments from the ini file \.{.fweb}. This resets |argc| and \
  4595. |argv|, and also ignores |argv[0]| from the command line. */
  4596. set_args(&argc,&argv);
  4597.  
  4598. /* Process all the arguments in order from left to right. */
  4599. do_args(YES,argc,argv,&found_web,wbflnm,&found_change);
  4600.  
  4601. if(statistics)
  4602. mem_avail(0);/* How much memory is available at start? */
  4603.  
  4604.  
  4605. {
  4606. outer_char HUGE*dot_pos;
  4607. outer_char HUGE*p= NULL;
  4608.  
  4609. if(STRLEN(wbflnm)>MAX_FILE_NAME_LENGTH-5)
  4610. too_long();
  4611.  
  4612. if(STRCMP(wbflnm,"stdin")==0)STRCPY(web_file_name,wbflnm);
  4613. else
  4614. {
  4615. p= OC(STRRCHR(wbflnm,prefix_end_char));/* Is there a path? */
  4616.  
  4617. if((dot_pos= OC(STRCHR(p?p+1:wbflnm,wt_style.ext_delimiter)))==NULL
  4618. &&!try_extensions)
  4619. {/* Attach ``\.{.web}'' as a default. */
  4620.  
  4621. if(
  4622. nsprintf(web_file_name,OC("%s%cweb"),2,wbflnm,wt_style.ext_delimiter)>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("web_file_name","");
  4623. }
  4624. else{/* There's a dot, or we're trying extensions; treat the \
  4625. name as is. */
  4626.  
  4627. if(
  4628. nsprintf(web_file_name,OC("%s"),1,wbflnm)>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("web_file_name","");
  4629.  
  4630. if(!try_extensions)
  4631. TERMINATE(dot_pos,0);/* string now ends where the \
  4632. dot was */
  4633. }
  4634. }
  4635.  
  4636.  
  4637. {
  4638. if(p)
  4639. {/* Path was specified. */
  4640. STRNCPY(wbprefix,wbflnm,
  4641. PTR_DIFF(size_t,p,(outer_char HUGE*)wbflnm)+1);/* Path. */
  4642. STRCPY(wbflnm0,p+1);/* Root name. */
  4643. }
  4644. else
  4645. {/* No path specification. */
  4646. TERMINATE(wbprefix,0);/* No path. */
  4647. STRCPY(wbflnm0,wbflnm);/* Root name. */
  4648. }
  4649. }
  4650.  
  4651.  
  4652. }
  4653.  
  4654.  
  4655.  
  4656.  
  4657. {
  4658. read_sty(style_file_name,renamed_style);/* See \.{style.web}. */
  4659.  
  4660.  
  4661. {
  4662. DOT_DELIMITER HUGE*d= &wt_style.dot_delimiter;
  4663.  
  4664. d->begin= XORD(d->begin);
  4665. d->end= XORD(d->end);
  4666.  
  4667. if(program==tangle)
  4668. {
  4669. t_style.ASCII_fcn= x__to_ASCII((outer_char*)t_style.ASCII_fcn);
  4670. }
  4671. }
  4672.  
  4673.  
  4674. }
  4675.  
  4676.  
  4677.  
  4678.  
  4679. {
  4680. int k;
  4681.  
  4682. /* \WEAVE's output file. */
  4683. xpn_name(&tex_fname,MAX_FILE_NAME_LENGTH,tex_fname,wbflnm0);
  4684. if(*tex_fname=='\0')new_fname(&tex_fname,wbflnm0,OC("tex"));
  4685.  
  4686. /* \TANGLE's output files. */
  4687. for(k= 0;k<NUM_LANGUAGES;k++)
  4688. xpn_name(params.outp_nm+k,MAX_FILE_NAME_LENGTH,
  4689. params.outp_nm[k],wbflnm0);
  4690.  
  4691. set_name(C,wt_style.output_ext.C_);
  4692. set_name(C_PLUS_PLUS,wt_style.output_ext.Cpp_);
  4693. set_name(LITERAL,wt_style.output_ext.V_);
  4694. set_name(FORTRAN,wt_style.output_ext.N_);
  4695. set_name(FORTRAN_90,wt_style.output_ext.N90_);
  4696. set_name(RATFOR,wt_style.output_ext.R_);
  4697. set_name(RATFOR_90,wt_style.output_ext.R90_);
  4698. set_name(TEX,wt_style.output_ext.X_);
  4699. }
  4700.  
  4701. ;
  4702.  
  4703. if(!(found_web||info_option))usage("!! Missing webfile name.\n",YES);
  4704. if(!found_change)*change_file_name= '\0';/* This means null file. */
  4705. }
  4706.  
  4707.  
  4708.  
  4709. outer_char HUGE*
  4710. cmd_line FCN((num_args,args))
  4711. int num_args C0("Number of arguments on command line.")
  4712. outer_char*args[]C1("Array of pointers to arguments.")
  4713. {
  4714. int k,len,l0,l1;
  4715. outer_char HUGE*buf,HUGE*b,HUGE*line0,HUGE*line1;
  4716. outer_char p[ESCAPE_LENGTH];/* The escaped argument. */
  4717.  
  4718. if(program==tangle)
  4719. {
  4720. line0= TANGLE_LINE0;
  4721. line1= TANGLE_LINE1;
  4722. }
  4723. else
  4724. {
  4725. line0= WEAVE_LINE0;
  4726. line1= WEAVE_LINE1;
  4727. }
  4728.  
  4729. /* Determine required buffer length. */
  4730. for(k= 0,len= 0;k<num_args;len+= STRLEN(args[k++])+1);
  4731.  
  4732. l0= STRLEN(line0);
  4733. l1= STRLEN(line1);
  4734. buf= GET_MEM("buf",2*(len+l0+l1),outer_char);
  4735. STRCPY(buf,line0);
  4736. b= buf+l0;
  4737.  
  4738. while(num_args-->0)
  4739. {
  4740. int n= esc_file_name(p,ESCAPE_LENGTH,*(args++));
  4741.  
  4742. STRNCPY(b,p,n);
  4743. b+= n;
  4744. *b++= ' ';
  4745. }
  4746.  
  4747. STRCPY(--b,line1);/* Kill off final blank. */
  4748. return buf;
  4749. }
  4750.  
  4751.  
  4752.  
  4753. SRTN
  4754. set_args FCN((pargc,pargv))
  4755. int HUGE*pargc C0("Pointer to the arg count; new value returned.")
  4756. outer_char HUGE*HUGE**pargv C1("Ptr to the array of ptrs; returned.")
  4757. {
  4758. int k,n;
  4759. outer_char HUGE*buffer,HUGE*b,/* Put one line from ini file into here. */
  4760. HUGE*temp,HUGE*t,/* Extract the argument into here. */
  4761. HUGE*HUGE*a,/* The current ini arg. */
  4762. HUGE*pc;/* Pointer to possible comment character in ini line. */
  4763. boolean blank;
  4764.  
  4765. /* Allocate temporary buffers. */
  4766. buffer= GET_MEM("buffer",T_SIZE,outer_char);
  4767. temp= GET_MEM("temp",T_SIZE,outer_char);
  4768.  
  4769. /* We start by assuming there is no ini file, hence no argument. */
  4770. k= 0;
  4771.  
  4772.  
  4773. {
  4774. outer_char ini_file_name[MAX_FILE_NAME_LENGTH];
  4775. outer_char*p_root,ini_root[MAX_FILE_NAME_LENGTH];
  4776.  
  4777. #if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
  4778. if((p_root= GETENV(ENV_INI))==NULL)STRCPY(ini_root,OC(FWEB_INI));
  4779. else STRCPY(ini_root,p_root);
  4780.  
  4781. more_includes(GETENV(ENV_INCLUDES));
  4782. #else
  4783. STRCPY(ini_root,OC(FWEB_INI));
  4784. #endif /* |HAVE_GETENV| */
  4785.  
  4786. ini_file= FOPEN(mk_fname(ini_file_name,MAX_FILE_NAME_LENGTH,
  4787. HOME,YES,ini_root),"r");
  4788. }
  4789.  
  4790.  
  4791.  
  4792. /* If there is an ini file, then put the arguments into an array. */
  4793. if(ini_file)
  4794. {
  4795. for(a= ini_args;k<MAX_INI_ARGS;)
  4796. {
  4797. if(FGETS(buffer,T_SIZE,ini_file)==NULL)break;/* Read one line \
  4798.         (including newline). */
  4799.  
  4800. /* Extract the string, disgarding the newline. If the line is blank, do \
  4801. nothing. */
  4802. blank= YES;
  4803. for(t= temp,b= buffer;*b;)
  4804. {
  4805. if(*b=='\n')break;
  4806. if(!isspace(*b))blank= NO;
  4807. *t++= *b++;
  4808. }
  4809. *t= '\0';
  4810.  
  4811. if(blank)continue;
  4812.  
  4813. /* Kill off any trailing comment. */
  4814. if((pc= OC(STRCHR(temp,INI_CMNT_CHAR)))!=NULL)TERMINATE(pc,0);
  4815. if(pc==temp)continue;/* The line was entirely a comment. */
  4816.  
  4817. *a= GET_MEM("ini arg",STRLEN(temp)+1,outer_char);/* Space for the \
  4818. argument. */
  4819. STRCPY(*a++,temp);/* Store ini argument. */
  4820. k++;
  4821. }
  4822.  
  4823. FCLOSE(ini_file);
  4824. }
  4825.  
  4826. /* Allocate space for all the arguments, both ini and command-line. (We \
  4827. don't count |argv[0]| from command line.) */
  4828. pn= new_args= GET_MEM("new_args",n= *pargc-1+k,outer_char HUGE*);
  4829.  
  4830. acopy(BEFORE_CHAR,ini_args,k);
  4831. /* Put those starting with '\.+' or '\.-' first. */
  4832. pn0= pn;/* Mark end of the ini stuff. */
  4833.  
  4834. acopy(MIDDLE_CHAR,(outer_char HUGE**)(*pargv),*pargc);
  4835. /* Then the command-line arguments. */
  4836.  
  4837. acopy(AFTER_CHAR,ini_args,k);/* Then the rest. */
  4838.  
  4839. /* Return the new number and array of arguments. */
  4840. *pargc= n;
  4841. *pargv= new_args;
  4842.  
  4843. FREE_MEM(buffer,"buffer",T_SIZE,char);
  4844. FREE_MEM(temp,"temp",T_SIZE,char);
  4845. }
  4846.  
  4847.  
  4848.  
  4849. SRTN
  4850. more_includes FCN((incl_list0))
  4851. outer_char*incl_list0 C1("")
  4852. {
  4853. unsigned n;
  4854. BUF_SIZE old_size;
  4855.  
  4856. if(!incl_list0)
  4857. return;
  4858.  
  4859. /* Strip off useless opening colon. */
  4860. while(*incl_list0==':')
  4861. incl_list0++;
  4862.  
  4863. if((n= STRLEN(incl_list0))==0)
  4864. return;
  4865.  
  4866. old_size= incl.size;
  4867. incl.size+= n+2;/* Allow for trailing colon and null byte. */
  4868.  
  4869. if(!incl.list)
  4870. {/* List hasn't been allocated yet. */
  4871. incl.list= GET_MEM("incl_list",incl.size,outer_char);
  4872. STRCPY(incl.list,incl_list0);
  4873. }
  4874. else
  4875. {/* Add more to the list. */
  4876. incl.list= (outer_char HUGE*)REALLOC(incl.list,incl.size,old_size);
  4877.  
  4878. if(incl.list==NULL)
  4879. FATAL(NULL,"!! No more memory (more_includes)","");
  4880.  
  4881. STRCAT(incl.list,incl_list0);
  4882. }
  4883.  
  4884. /* Ensure list ends in a colon. */
  4885. if(incl.list[n-1]!=':')incl.list[n]= ':';
  4886. }
  4887.  
  4888.  
  4889.  
  4890. char*
  4891. mk_fname FCN((buffer,buf_len,env_var,print_msg,file_name))
  4892. outer_char*buffer C0("Put result here.")
  4893. unsigned buf_len C0("Length of |buffer|.")
  4894. CONST outer_char*env_var C0("Variable that holds directory name.")
  4895. boolean print_msg C0("Flag for not recognizing |env_var|.")
  4896. CONST outer_char*file_name C1("The raw file name.")
  4897. {
  4898. outer_char*directory;/* Will hold result of |getenv|. */
  4899.  
  4900. #if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
  4901. if((directory= GETENV(env_var))==NULL)
  4902. {
  4903. if(print_msg)
  4904. printf("! I can't find environment \
  4905. variable \"%s\", so I'll look for file \"%s\" \
  4906. in directory \"%s\".\n",
  4907. (char*)env_var,(char*)file_name,
  4908. *wbprefix?(char*)wbprefix:".");
  4909. if(buf_chk(file_name,buf_len,
  4910. STRLEN(file_name)+STRLEN(wbprefix)))
  4911. return(char*)wt_style.null_file_name;
  4912. STRCPY(buffer,wbprefix);
  4913. STRCAT(buffer,file_name);
  4914. }
  4915. else
  4916. {/* Got a directory from the environment variable. */
  4917. if(buf_chk(file_name,buf_len,
  4918. STRLEN(directory)+1+STRLEN(file_name)))
  4919. return(char*)wt_style.null_file_name;
  4920. /* For Unix, home is of the form \
  4921. \.{/u/krommes}; for VMS, it's like \.{ux3:[krommes]}. */
  4922. #if !UNIX_PATH
  4923.  
  4924. if(
  4925. nsprintf(buffer,OC("%s%s"),2,directory,file_name)>=(int)(buf_len))OVERFLW("buffer","");
  4926. #else
  4927.  
  4928. if(
  4929. nsprintf(buffer,OC("%s%c%s"),3,directory,prefix_end_char,file_name)>=(int)(buf_len))OVERFLW("buffer","");
  4930. #endif /* |!UNIX_PATH| */
  4931. }
  4932. #else /* Doesn't understand |getenv|. */
  4933. if(buf_chk(file_name,buf_len,STRLEN(file_name)))
  4934. return(char*)wt_style.null_file_name;
  4935. STRCPY(buffer,file_name);
  4936. #endif /* |CAN_GETENV| */
  4937.  
  4938. return(char*)buffer;
  4939. }
  4940.  
  4941.  
  4942.  
  4943. boolean
  4944. buf_chk FCN((file_name,buf_len,needed))
  4945. CONST outer_char*file_name C0("Raw file name")
  4946. unsigned buf_len C0("Max space available")
  4947. unsigned needed C1("Requested")
  4948. {
  4949. if(needed>=buf_len)
  4950. {
  4951. printf("\n! Buffer too small to make complete file name from \
  4952. \"%s\"; opened \"%s\"\n",(char*)file_name,(char*)wt_style.null_file_name);
  4953. return YES;
  4954. }
  4955.  
  4956. return NO;
  4957. }
  4958.  
  4959.  
  4960.  
  4961. SRTN
  4962. acopy FCN((c,a,n))
  4963. outer_char c C0("Starting symbol.")
  4964. outer_char HUGE**a C0("Old array.")
  4965. int n C1("Number of arguments to be looked at.")
  4966. {
  4967. boolean is_before= BOOLEAN(c==BEFORE_CHAR||c=='+');
  4968. boolean is_middle= BOOLEAN(c==MIDDLE_CHAR);
  4969. boolean is_after= BOOLEAN(c==AFTER_CHAR);
  4970. int k;
  4971.  
  4972. /* Disgard the zeroth argument from the command line. */
  4973. if(is_middle)
  4974. {
  4975. k= 1;
  4976. a++;
  4977. }
  4978. else
  4979. k= 0;
  4980.  
  4981. /* Look at all the arguments; copy them if appropriate. */
  4982. for(;k<n;k++,a++)
  4983. {
  4984. boolean before_entry= BOOLEAN((*a)[0]==BEFORE_CHAR||(*a)[0]=='+');
  4985.  
  4986. /* The following somewhat inscrutable logic puts file names and ``after'' \
  4987. entries from \.{.fweb} into the ``after'' list. */
  4988. if((!is_before&&!before_entry)||(!is_after&&before_entry))
  4989. {
  4990. *pn= GET_MEM("*pn",STRLEN(*a)+1,outer_char);
  4991. STRCPY(*pn,*a);
  4992. if((*pn)[0]=='+'||(*pn)[0]==AFTER_CHAR)
  4993. (*pn)[0]= BEFORE_CHAR;
  4994. pn++;
  4995. }
  4996. }
  4997. }
  4998.  
  4999.  
  5000.  
  5001. SRTN
  5002. set_name FCN((l,output_ext))
  5003. LANGUAGE l C0("")
  5004. outer_char*output_ext C1("")
  5005. {
  5006. int k;
  5007.  
  5008. if(*params.outp_nm[k= lan_num(l)]=='\0')
  5009. new_fname(params.outp_nm+k,wbflnm0,output_ext);
  5010. }
  5011.  
  5012.  
  5013.  
  5014. outer_char HUGE*
  5015. xpn_name FCN((pout_name,buf_len,in_name,wbflnm0))
  5016. outer_char HUGE*HUGE*pout_name C0("The expanded result")
  5017. int buf_len C0("Length of above buffer")
  5018. CONST outer_char*in_name C0("File name possibly having a \.\#.")
  5019. CONST outer_char wbflnm0[]C1("Basic name of the web file.")
  5020. {
  5021. size_t n;/* Length of the root name. */
  5022. outer_char HUGE*t,HUGE*t0= NULL;
  5023. boolean buffered= BOOLEAN(*pout_name==in_name);
  5024.  
  5025. if(buffered)t= t0= GET_MEM("xpn buffer",buf_len,outer_char);
  5026. else t= *pout_name;
  5027.  
  5028. for(;*in_name;in_name++)
  5029. if(*in_name=='#')
  5030. {
  5031. n= STRLEN(wbflnm0);
  5032. STRNCPY(t,wbflnm0,n);
  5033. t+= n;
  5034. }
  5035. else*t++= *in_name;
  5036.  
  5037. TERMINATE(t,0);
  5038.  
  5039. if(buffered)
  5040. {
  5041. new_fname(pout_name,t0,NULL);
  5042. FREE_MEM(t0,"xpn buffer",buf_len,outer_char);
  5043. }
  5044.  
  5045. return*pout_name;
  5046. }
  5047.  
  5048.  
  5049.  
  5050.  
  5051. SRTN
  5052. read_aux(VOID)
  5053. {
  5054. outer_char aux_file_name[MAX_FILE_NAME_LENGTH];
  5055. FILE*fa;
  5056. outer_char buffer[AUX_LEN];
  5057. int aline= 0;/* Counts line in the \.{.aux} file. */
  5058. sixteen_bits modno,modno0;
  5059. outer_char smodno[10],smodno0[10],spageno[10],ssecno[100];
  5060. int n;
  5061. SECT_INFO*ps;/* Points to current info structure. */
  5062. int pmcount= 1;/* Number of sections per page. */
  5063. long modno_ref= -1;/* Last reference module number.  It's |long| to deal \
  5064.     with the possibility of 16-bit integers, where |-1| would be the \
  5065.     maximum module number. */
  5066.  
  5067. next_mod_name= mod_names= GET_MEM("mod_names",MAX_MOD_NAMES,
  5068. outer_char HUGE*);
  5069. last_mod_name= mod_names+MAX_MOD_NAMES;
  5070.  
  5071. if(TeX_processor!=LaTeX_p)
  5072. return;
  5073.  
  5074.  
  5075. {
  5076. outer_char*dot_pos;/* For finding extension in file name. */
  5077.  
  5078. dot_pos= OC(STRCHR(tex_fname,wt_style.ext_delimiter));
  5079.  
  5080. if(dot_pos==NULL)
  5081. n= STRLEN(tex_fname);
  5082. else
  5083. n= PTR_DIFF(int,dot_pos,tex_fname);
  5084.  
  5085. STRNCPY(aux_file_name,tex_fname,n);
  5086.  
  5087. if(
  5088. nsprintf(aux_file_name+n,OC("%caux"),1,wt_style.ext_delimiter)>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("aux_file_name+n","");
  5089.  
  5090. fa= FOPEN(aux_file_name,"r");
  5091.  
  5092. if(!fa)
  5093. {
  5094. printf("(No %s file.)\n",(char*)aux_file_name);
  5095. return;
  5096. }
  5097. else
  5098. reading(aux_file_name,YES);
  5099.  
  5100. }
  5101.  
  5102.  
  5103.  
  5104. modno= 0;/* In case there's nothing in the \.{.aux} file. */
  5105.  
  5106. while(FGETS(buffer,AUX_LEN,fa))
  5107. {
  5108. aline++;
  5109.  
  5110. if(STRNCMP(buffer,"\\Newlabel",9)!=0)
  5111. continue;
  5112.  
  5113.  
  5114. {
  5115. #if(!ANSI_SSCANF)
  5116. {
  5117.  
  5118. err0_print(ERR_C,OC("Sorry, non-ANSI sscanf; can't read .aux file"),0);
  5119. return;
  5120. }
  5121. #endif
  5122.  
  5123. n= sscanf((char*)(buffer+9),"%*c%[^}]%*3c%[^}]%*2c%[^}]%*3c%[^}]",
  5124. (char*)smodno,(char*)ssecno,(char*)spageno,(char*)smodno0);
  5125.  
  5126. if(n!=4)
  5127. {
  5128.  
  5129. err0_print(ERR_C,OC("Invalid \\Newlabel format in %s file, line %d"),2,aux_file_name,aline);
  5130. return;
  5131. }
  5132.  
  5133. modno= (sixteen_bits)ATOI(smodno);
  5134.  
  5135. if(modno>=max_modules)
  5136. OVERFLW("sections","m");
  5137.  
  5138. ps= sect_info+modno;
  5139.  
  5140. ps->secno= GET_MEM("ps->secno",STRLEN(ssecno)+1,outer_char);
  5141. STRCPY(ps->secno,ssecno);
  5142.  
  5143. ps->pageno= (sixteen_bits)ATOI(spageno);
  5144. ps->modno0= modno0= (sixteen_bits)ATOI(smodno0);
  5145.  
  5146. /* Check to see whether there was more than one section on a page.  */
  5147. sect_info[modno-1].subpage_flag= YES;
  5148.  
  5149. if((long)modno0==modno_ref)
  5150. pmcount++;/* More than one section on page. */
  5151. else
  5152. {/* Start of new page. */
  5153. if(pmcount==1)
  5154. sect_info[modno-1].subpage_flag= NO;
  5155.  
  5156. modno_ref= (long)modno0;
  5157. pmcount= 1;
  5158. }
  5159. }
  5160.  
  5161.  
  5162. }
  5163.  
  5164. sect_info[modno].subpage_flag= BOOLEAN(pmcount!=1);
  5165. fclose(fa);
  5166. }
  5167.  
  5168.  
  5169.  
  5170. outer_char HUGE*
  5171. mod_trans FCN((prefix,modno))
  5172. outer_char*prefix C0("")
  5173. sixteen_bits modno C1("")
  5174. {
  5175. outer_char HUGE*mod_temp= GET_MEM("mod_temp",NMOD_TEMP,outer_char);
  5176. SECT_INFO*ps= sect_info+modno;
  5177.  
  5178. if(ps->secno)
  5179. {
  5180. outer_char letter[2];
  5181.  
  5182. letter[1]= '\0';
  5183.  
  5184. letter[0]= (ps->subpage_flag?
  5185. XCHR(modno-ps->modno0+0141-1):'\0');
  5186.  
  5187. if(letter[0]&&XORD(letter[0])>0172)
  5188. letter[0]= '?';
  5189.  
  5190.  
  5191. if(
  5192. nsprintf(mod_temp,OC("%s %d (sect. %s, p. %d%s)"),5,prefix,modno,ps->secno,ps->pageno,letter)>=(int)(NMOD_TEMP))OVERFLW("mod_temp","");
  5193. }
  5194. else
  5195. {
  5196.  
  5197. if(
  5198. nsprintf(mod_temp,OC("%s %d"),2,prefix,modno)>=(int)(NMOD_TEMP))OVERFLW("mod_temp","");
  5199. }
  5200.  
  5201. if(next_mod_name==last_mod_name)
  5202. CONFUSION("mod_trans","too many unfreed mod names");
  5203.  
  5204. return*(next_mod_name++)= mod_temp;
  5205. }
  5206.  
  5207.  
  5208.  
  5209. SRTN
  5210. mfree(VOID)
  5211. {
  5212. if(!mod_names)return;/* For errors happening during the command line. */
  5213.  
  5214. for(--next_mod_name;next_mod_name>=mod_names;next_mod_name--)
  5215. FREE(*next_mod_name);
  5216. }
  5217.  
  5218.  
  5219.  
  5220. int
  5221. lan_num FCN((Language))
  5222. LANGUAGE Language C1("")
  5223. {
  5224. proper_language:
  5225. switch(Language)
  5226. {
  5227. case C:return 0;
  5228. case RATFOR:return 1;
  5229. case FORTRAN:return 2;
  5230. case TEX:return 3;
  5231. case LITERAL:return 4;
  5232.  
  5233. case C_PLUS_PLUS:return 5;
  5234. case RATFOR_90:return 6;
  5235. case FORTRAN_90:return 7;
  5236.  
  5237. case NO_LANGUAGE:Language= GLOBAL_LANGUAGE;goto proper_language;
  5238. default:Language= global_language;goto proper_language;
  5239. }
  5240. }
  5241.  
  5242. LANGUAGE
  5243. lan_enum FCN((num))
  5244. int num C1("Integer index of the language.")
  5245. {
  5246. switch(num)
  5247. {
  5248. case 0:return C;
  5249. case 1:return RATFOR;
  5250. case 2:return FORTRAN;
  5251. case 3:return TEX;
  5252. case 4:return LITERAL;
  5253.  
  5254. case 5:return C_PLUS_PLUS;
  5255. case 6:return RATFOR_90;
  5256. case 7:return FORTRAN_90;
  5257.  
  5258. default:return NO_LANGUAGE;
  5259. }
  5260. }
  5261.  
  5262.  
  5263. int
  5264. lan_index FCN((Language))
  5265. LANGUAGE Language C1("")
  5266. {
  5267. proper_language:
  5268. switch(Language)
  5269. {
  5270. case C:return 0;
  5271.  
  5272. case RATFOR:
  5273. case FORTRAN:return 1;
  5274.  
  5275. case TEX:return 2;
  5276. case LITERAL:return 3;
  5277.  
  5278. case C_PLUS_PLUS:return 4;
  5279.  
  5280. case RATFOR_90:
  5281. case FORTRAN_90:return 5;
  5282.  
  5283. case NO_LANGUAGE:Language= GLOBAL_LANGUAGE;goto proper_language;
  5284. default:Language= global_language;goto proper_language;
  5285. }
  5286. }
  5287.  
  5288.  
  5289.  
  5290. SRTN
  5291. do_args FCN((doing_cmd_line0,argc,argv,pfound_web,wbflnm,pfound_change))
  5292. boolean doing_cmd_line0 C0("")
  5293. int argc C0("")
  5294. outer_char HUGE*argv[]C0("")
  5295. boolean HUGE*pfound_web C0("")
  5296. outer_char wbflnm[]C0("")
  5297. boolean HUGE*pfound_change C1("")
  5298. {
  5299. boolean a_file_name;/* Is an actual file name supplied from the command line? */
  5300. outer_char HUGE*dot_pos;/* Position of |'.'| (or more generally, \
  5301.             |wt_style.ext_delimiter|) in the argument */
  5302. IN_STYLE outer_char HUGE*sprm_ptr0,HUGE*sprm_ptr;
  5303.  
  5304. doing_cmd_line= doing_cmd_line0;
  5305. cmd_prms= NO;
  5306.  
  5307. *pfound_web= *pfound_change= NO;
  5308.  
  5309. while(argc-->0)
  5310. {
  5311. if(!cmd_prms&&argv==pn0)
  5312. {/* Note beginning of command-line parameters. */
  5313. cmd_prms= YES;
  5314. sprm_ptr0= sprm_ptr;
  5315. }
  5316.  
  5317. pa= *(argv++);/* Beginning of current argument string. */
  5318.  
  5319. /* Arguments that don't begin with a hyphen, or that are just a single \
  5320. hyphen with no trailing stuff, mean file names. */
  5321. if((a_file_name= BOOLEAN(*pa!='-'))||*(pa+1)=='\0')
  5322.  
  5323. {
  5324. if(doing_cmd_line)
  5325. {
  5326. if(!*pfound_web)
  5327. {
  5328. STRCPY(wbflnm,THE_FILE_NAME);
  5329. *pfound_web= YES;
  5330. }
  5331. else if(!*pfound_change)
  5332.  
  5333. {
  5334. if(a_file_name&&STRLEN(pa)>MAX_FILE_NAME_LENGTH-5)
  5335. too_long();
  5336.  
  5337. /* For VMS, should skip over brackets here. */
  5338.  
  5339. if(a_file_name&&(dot_pos= OC(STRCHR(pa,wt_style.ext_delimiter)))==NULL
  5340. &&!try_extensions)
  5341. {
  5342.  
  5343. if(
  5344. nsprintf(change_file_name,OC("%s%cch"),2,pa,wt_style.ext_delimiter)>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("change_file_name","");
  5345. }
  5346. else
  5347. {
  5348.  
  5349. if(
  5350. nsprintf(change_file_name,OC("%s"),1,THE_FILE_NAME)>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("change_file_name","");
  5351. }
  5352.  
  5353. *pfound_change= YES;
  5354. }
  5355.  
  5356.  
  5357. else
  5358.  
  5359. {
  5360. printf("! Warning: Ignoring multiple change file \"%s\".\n",
  5361. (char*)THE_FILE_NAME);
  5362. mark_harmless;
  5363. continue;
  5364. }
  5365.  
  5366. ;
  5367. }
  5368. else
  5369. {
  5370. printf("\n! File name \"%s\" is not allowed as optional argument; \
  5371. ignored.\n",pa);
  5372. mark_harmless;
  5373. }
  5374. }
  5375.  
  5376.  
  5377. else
  5378.  
  5379. {
  5380. outer_char mc;
  5381. outer_char cmd_symbol;/* The character after the hyphen. */
  5382.  
  5383.  
  5384. pa++;/* |pa| now points to the character after the hyphen. */
  5385.  
  5386. if(*pa=='-')
  5387. {/* Second hyphen means negate. */
  5388. not= YES;
  5389. pa++;/* Skip second hyphen. */
  5390. }
  5391. else
  5392. not= NO;
  5393.  
  5394. reswitch:
  5395. switch(cmd_symbol= *pa++)
  5396. {/* |pa| now positioned after command symbol---e.g., to optional \
  5397. argument. */
  5398. case '1':
  5399. case '2':
  5400. tracing= cmd_symbol-'0';break;
  5401.  
  5402. case '@':
  5403.  
  5404. {
  5405. if(!at_codes)
  5406. {
  5407. at_codes= GET_MEM("at_codes",200,ASCII);/* 200 is KLUDGE! */
  5408. at_codes[0]= '\0';
  5409. }
  5410.  
  5411. STRCAT(at_codes,to_ASCII(pa));
  5412. info_option= YES;
  5413. }
  5414.  
  5415.  
  5416. break;
  5417.  
  5418. case 'a':
  5419. case 'A':
  5420.  
  5421. {
  5422. #if(TRANSLATE_ASCII || DEBUG_XCHR)
  5423. translate_ASCII= YES;/* Force it for the cases that really need it. */
  5424. #else
  5425. translate_ASCII= NOT(TRANSLATE_ASCII0);
  5426. #endif
  5427. }
  5428.  
  5429.  
  5430.  
  5431. break;
  5432.  
  5433. case 'b':
  5434.  
  5435. {
  5436. params.Block_nums[LN(FORTRAN)]
  5437. = params.Block_nums[LN(FORTRAN_90)]
  5438. = params.Block_nums[LN(RATFOR)]
  5439. = params.Block_nums[LN(RATFOR_90)]
  5440. = NOT(BLOCK_NUMS);
  5441. }
  5442.  
  5443.  
  5444. break;
  5445.  
  5446. case 'B':
  5447. beeps= NOT(BEEPS);
  5448. break;
  5449.  
  5450.  
  5451. case 'c':case 'C'
  5452.  
  5453. :
  5454.  
  5455. {
  5456.  
  5457. cant_negate(pa-2);
  5458.  
  5459.  
  5460.  
  5461. Cpp= BOOLEAN(*pa=='+');/* The commands \.{-c+} or \.{-c++} turn on \
  5462.                 knowledge of \.{C++}. */
  5463. if(Cpp)while(*pa=='+')pa++;/* Skip the pluses. */
  5464.  
  5465. switch(*pa)
  5466. {
  5467. case '{':
  5468. set_filter(Cpp?C_PLUS_PLUS:C);
  5469. break;
  5470.  
  5471. case '\0':
  5472. ini_language(XORD(*LANGUAGE_CODE(C)));
  5473. break;
  5474.  
  5475. default:
  5476. break;
  5477. }
  5478. }
  5479.  
  5480.  
  5481.  
  5482. break;
  5483.  
  5484. case 'D':
  5485.  
  5486. {
  5487. if(*pa=='[')
  5488.  
  5489. {
  5490. for(++pa;*pa!=']';pa++)
  5491. switch(*pa)
  5492. {
  5493. case 'i':
  5494. case 'I':
  5495. rsrvd.intrinsics= YES;
  5496. break;
  5497.  
  5498. case 'k':
  5499. case 'K':
  5500. rsrvd.keywords= YES;
  5501. break;
  5502.  
  5503. case 'r':
  5504. case 'R':
  5505. rsrvd.reserveds= YES;
  5506. break;
  5507.  
  5508. case '\0':
  5509.  
  5510. err0_print(ERR_C,OC("Missing ']' inserted after optional argument \
  5511. list to `-D'"),0);
  5512. break;
  5513.  
  5514. default:
  5515.  
  5516. err0_print(ERR_C,OC("Optional argument to `-D' must be one of \
  5517. 'i', 'k', or 'r'"),0);
  5518. break;
  5519. }
  5520.  
  5521. pa++;/* Advance past the \.{']'}. */
  5522. }
  5523.  
  5524.  
  5525. else if(!(*pa=='\0'||*pa=='*'||isalpha(*pa)))
  5526. {
  5527.  
  5528. err0_print(ERR_C,OC("Either nothing, a letter, '*', or '[' must follow `-D'; \
  5529. option ignored"),0);
  5530. break;
  5531. }
  5532.  
  5533. rsrvd.args= pa;
  5534.  
  5535. if(!*pa)
  5536. rsrvd.reserveds= YES;
  5537.  
  5538. info_option= YES;
  5539. }
  5540.  
  5541.  
  5542. break;
  5543. case 'd':
  5544. number_dos= NOT(NUMBER_DOS);/* NOTE:  falls through to next case! */
  5545.  
  5546. case ':':
  5547.  
  5548. {
  5549.  
  5550. cant_negate(pa-2);
  5551.  
  5552.  
  5553.  
  5554. max_stmt= STARTING_DO_NUM;
  5555.  
  5556. if(*pa)
  5557. {/* Optional starting line number specified. */
  5558. max_stmt= ATOL(pa);
  5559.  
  5560. if(max_stmt>99999L)
  5561.  
  5562. err0_print(ERR_C,OC("Starting DO number must be < 99999; assuming %lu"),1,max_stmt= STARTING_DO_NUM);
  5563. }
  5564. }
  5565.  
  5566.  
  5567.  
  5568. break;
  5569.  
  5570. case 'e':
  5571. try_extensions= NOT(TRY_EXTENSIONS);break;
  5572.  
  5573. case 'E':
  5574.  
  5575. {
  5576.  
  5577. cant_negate(pa-2);
  5578.  
  5579.  
  5580.  
  5581. if(*pa)wt_style.ext_delimiter= *pa;
  5582. else
  5583. err0_print(ERR_C,OC("Missing character after -E option; option ignored"),0);
  5584. }
  5585.  
  5586.  
  5587. break;
  5588.  
  5589. case 'f':
  5590. subscript_fcns= NOT(SUBSCRIPT_FCNS);break;
  5591.  
  5592. case 'F':
  5593. compare_outfiles= NOT(COMPARE_OUTFILES);break;
  5594.  
  5595. case 'g':
  5596. dbg_output= NOT(DBG_OUTPUT);break;
  5597.  
  5598. case 'h':
  5599.  
  5600. cant_negate(pa-2);
  5601.  
  5602.  
  5603. help();
  5604. break;
  5605.  
  5606. case 'H':
  5607.  
  5608. {
  5609. outer_char HUGE*p= pa;
  5610.  
  5611. more_H:
  5612. switch(*p++)
  5613. {
  5614. case 'r':
  5615. rmv_files= NOT(RMV_FILES);/* For debugging. */
  5616. goto more_H;
  5617.  
  5618. case 'x':
  5619. quoted_includes= NOT(QUOTED_INCLUDES);
  5620. goto more_H;
  5621.  
  5622. case 'X':
  5623. all_includes= NOT(ALL_INCLUDES);
  5624. goto more_H;
  5625.  
  5626. case '\0':
  5627. read_iformats= NOT(READ_IFORMATS);
  5628. break;
  5629.  
  5630. default:
  5631. bad_option();
  5632. break;
  5633. }
  5634. }
  5635.  
  5636.  
  5637. break;
  5638.  
  5639. case 'i':
  5640.  
  5641. {
  5642. switch(*pa)
  5643. {
  5644. case 'x':
  5645. index_hidden= NOT(INDEX_HIDDEN);/* Falls through. */
  5646.  
  5647. case '\0':
  5648. toggle_includes= NOT(TOGGLE_INCLUDES);break;
  5649.  
  5650. case '!':
  5651. skip_includes= NOT(SKIP_INCLUDES);break;
  5652.  
  5653. default:
  5654. bad_option();break;
  5655. }
  5656. }
  5657.  
  5658.  
  5659. break;
  5660.  
  5661. case 'I':
  5662. more_includes(pa);/* Add to include path list. */
  5663. break;
  5664.  
  5665. case 'j':
  5666. skip_ifiles= NOT(SKIP_IFILES);break;
  5667.  
  5668. case 'k':
  5669. lc_keywords= NOT(LC_KEYWORDS);break;
  5670.  
  5671. case 'l':
  5672.  
  5673. {
  5674. prn_input_lines= BOOLEAN(YES^not);
  5675.  
  5676. if(*pa)
  5677. if(isdigit(*pa)||*pa=='-')
  5678. {
  5679. outer_char*colon_pos;
  5680.  
  5681. start_line= ATOL(pa);
  5682. if((colon_pos= OC(STRCHR(pa,':')))==NULL)
  5683. end_line= LONG_MAX;
  5684. else end_line= ATOL(colon_pos+1);
  5685. }
  5686.  
  5687. else
  5688. {
  5689. printf("! Option `-l' must be followed by integer.\n");
  5690. mark_harmless;
  5691. }
  5692.  
  5693. /* Negative line numbers are undocumented; they're for the developer. */
  5694. if(start_line<0)
  5695. {
  5696. start_line= -start_line;
  5697. prn_input_addresses= YES;
  5698. }
  5699. }
  5700.  
  5701.  
  5702.  
  5703. break;
  5704.  
  5705. case 'L':
  5706.  
  5707. {
  5708. switch(*pa)
  5709. {
  5710.  
  5711. case 'c':case 'C'
  5712.  
  5713. :
  5714.  
  5715. case 'n':case 'N'
  5716.  
  5717. :
  5718.  
  5719. case 'r':case 'R'
  5720.  
  5721. :
  5722. goto reswitch;
  5723.  
  5724.  
  5725. case 'v':case 'V'
  5726.  
  5727.  
  5728.  
  5729. :
  5730.  
  5731. cant_negate(pa-2);
  5732.  
  5733.  
  5734. switch(*(pa+1))
  5735. {
  5736. case '{':
  5737. set_filter(LITERAL);
  5738. break;
  5739.  
  5740. case '\0':
  5741. ini_language(XORD(*LANGUAGE_CODE(LITERAL)));
  5742. break;
  5743.  
  5744. default:
  5745. bad_lcmd("argument",pa-2);
  5746. break;
  5747. }
  5748. break;
  5749.  
  5750.  
  5751. case 'x':case 'X'
  5752.  
  5753. :
  5754.  
  5755. cant_negate(pa-2);
  5756.  
  5757.  
  5758. switch(*(pa+1))
  5759. {
  5760. case '{':
  5761. set_filter(TEX);
  5762. break;
  5763.  
  5764. case '\0':
  5765. ini_language(XORD(*LANGUAGE_CODE(TEX)));
  5766. break;
  5767.  
  5768. default:
  5769. bad_lcmd("argument",pa-2);
  5770. break;
  5771. }
  5772. break;
  5773.  
  5774. default:
  5775. bad_lcmd("command",pa-2);
  5776. break;
  5777. }
  5778. }
  5779.  
  5780.  
  5781. break;
  5782.  
  5783. case 'm':
  5784. case 'M':
  5785.  
  5786. {
  5787. switch(*pa)
  5788. {
  5789. case '4':
  5790. /* Recognize \.{m4} definitions. */
  5791.  
  5792. cant_negate(pa-2);
  5793.  
  5794.  
  5795. m4= !M4_;
  5796. break;
  5797.  
  5798. case ';':
  5799. /* Automatically append pseudo-semi to \.{WEB} macro definition. */
  5800. auto_app_semi= NOT(AUTO_APP_SEMI);
  5801. break;
  5802.  
  5803. case '\0':
  5804.  
  5805. err0_print(ERR_C,OC("Missing id for 'm' option"),0);
  5806. break;
  5807.  
  5808. default:
  5809. if(not)goto undefine_macro;
  5810.  
  5811. define_macro:
  5812. mc= *pa;
  5813.  
  5814. if(!(isalpha(mc)||mc=='_'||mc=='$'))
  5815.  
  5816. err0_print(ERR_C,OC("Macro definition may not start with \
  5817. '%c'; -m option ignored"),1,mc);
  5818. else SAVE_MACRO(pa);/* Macro definition. */
  5819.  
  5820. break;
  5821. }
  5822. }
  5823.  
  5824.  
  5825. break;
  5826.  
  5827.  
  5828. case 'N':
  5829. nuweb_mode= NOT(NUWEB_MODE);
  5830. break;
  5831.  
  5832. case 'n':
  5833. FR_args(FORTRAN);
  5834. break;
  5835.  
  5836. case 'o':
  5837. overload_ops= NOT(OVERLOAD_OPS);
  5838. break;
  5839.  
  5840. case 'p':
  5841.  
  5842. {
  5843. IN_STYLE outer_char HUGE*sprm_buf,HUGE*sprm_ptr,HUGE*sprm_end;
  5844. int n= STRLEN(pa);
  5845. size_t nbuf,nused;
  5846.  
  5847. if(!sprm_buf)
  5848. {/* Allocate the style-parameter buffer. */
  5849. sprm_ptr= sprm_buf= GET_MEM("sprm_buf",SPRM_LEN,outer_char);
  5850. sprm_end= sprm_buf+SPRM_LEN;
  5851. nbuf= SPRM_LEN;
  5852. }
  5853.  
  5854. if(sprm_ptr+(n+2)>=sprm_end)
  5855. {/* Reallocate a larger buffer. */
  5856. BUF_SIZE old_size;
  5857.  
  5858. nused= PTR_DIFF(size_t,sprm_ptr,sprm_buf);
  5859. old_size= nbuf;
  5860. nbuf= PTR_DIFF(size_t,sprm_end,sprm_buf)+SPRM_LEN;
  5861.  
  5862. if((sprm_buf= (outer_char HUGE*)REALLOC(sprm_buf,
  5863. nbuf*sizeof(outer_char),old_size*sizeof(outer_char)))==NULL)
  5864. OVERFLW("sprm_buf",0);
  5865.  
  5866. sprm_ptr= sprm_buf+nused;
  5867. sprm_end= sprm_ptr+nbuf;
  5868. }
  5869.  
  5870. /* Add a line (terminated with space and newline). */
  5871. STRCPY(sprm_ptr,pa);
  5872. sprm_ptr+= n;
  5873. *sprm_ptr++= ' ';
  5874. *sprm_ptr++= '\n';
  5875. }
  5876.  
  5877.  
  5878. break;
  5879.  
  5880. case 'P':
  5881.  
  5882. {
  5883. switch(*pa)
  5884. {
  5885. default:
  5886.  
  5887. err0_print(ERR_C,OC("'%c' is invalid option for -X; must be either 'L' \
  5888. (LaTeX) or 'T' (TeX).  LaTeX is assumed"),1,*pa);/* Falls through to \LaTeX\ case. */
  5889.  
  5890. case '\0':
  5891. case 'L':
  5892. TeX_processor= LaTeX_p;
  5893. break;
  5894.  
  5895. case 'T':
  5896. TeX_processor= TeX_p;
  5897. break;
  5898. }
  5899. }
  5900.  
  5901.  
  5902.  
  5903. break;
  5904.  
  5905. case 'q':
  5906. free_form_input= NOT(FREE_FORM_INPUT);
  5907. Ratfor77= NOT(RATFOR77);
  5908. break;
  5909.  
  5910.  
  5911. case 'r':case 'R'
  5912.  
  5913. :
  5914. if(!RAT_OK("Language command ignored"))
  5915. break;
  5916. FR_args(RATFOR);
  5917. break;
  5918.  
  5919. case 's':
  5920.  
  5921. {
  5922. statistics= NOT(STATISTICS);
  5923.  
  5924. /* The format ``\.{-sm100}'' says to display memory allocations for sizes \
  5925. $>= 100$ bytes. */
  5926. if(*pa)
  5927. if(*pa=='m')
  5928. {
  5929. pa++;/* |pa| positioned to byte size. */
  5930. show_mem= NOT(SHOW_MEM);
  5931. if(isdigit(*pa))show_size= ATOL(pa);
  5932. }
  5933. else
  5934. {
  5935. printf("! Option \"%s\" is invalid.\n",(char*)(pa-2));
  5936. mark_harmless;
  5937. }
  5938. }
  5939.  
  5940.  
  5941. break;
  5942.  
  5943. case 't':
  5944.  
  5945. {
  5946.  
  5947. cant_negate(pa-2);
  5948.  
  5949.  
  5950. ntrunc();
  5951. }
  5952.  
  5953.  
  5954. break;
  5955.  
  5956. case 'T':
  5957.  
  5958. {
  5959. outer_char HUGE*p= pa;
  5960.  
  5961. while(*p)
  5962. switch(*p++)
  5963. {
  5964. case 'D':
  5965. deferred_macros= NOT(DEFERRED_MACROS);
  5966. break;
  5967.  
  5968. case 'v':
  5969. top_version= NOT(TOP_VERSION);
  5970. break;
  5971.  
  5972. case '%':
  5973. keep_trailing_comments= NOT(KEEP_TRAILING_COMMENTS);
  5974. break;
  5975.  
  5976. case '#':
  5977. auto_line= NOT(AUTO_LINE);
  5978. break;
  5979.  
  5980. default:
  5981. bad_option();
  5982. break;
  5983. }
  5984. }
  5985.  
  5986.  
  5987. break;
  5988.  
  5989. case 'u':
  5990.  
  5991. {
  5992. if(not)
  5993. goto define_macro;
  5994.  
  5995. undefine_macro:
  5996. if(*pa=='\0')
  5997.  
  5998. err0_print(ERR_C,OC("Missing identifier for `-u' option"),0);
  5999. else
  6000. save_macro(OC("#undef"),pa);
  6001. }
  6002.  
  6003.  
  6004.  
  6005. break;
  6006.  
  6007. case 'U':
  6008. lowercase_tokens= NOT(LOWERCASE_TOKENS);
  6009. break;
  6010.  
  6011. case 'v':
  6012. all_cmnts_verbatim= NOT(ALL_CMNTS_VERBATIM);
  6013. break;
  6014.  
  6015. case 'w':
  6016. if(*pa)
  6017. new_fname(&fwebmac,pa,NULL);
  6018. else
  6019. input_macros= NOT(INPUT_MACROS);
  6020.  
  6021. break;
  6022.  
  6023. case 'W':
  6024.  
  6025. {
  6026. outer_char HUGE*p= pa;
  6027.  
  6028. while(*p)
  6029. switch(*p++)
  6030. {
  6031. case '[':
  6032. active_brackets= NOT(ACTIVE_BRACKETS);
  6033. break;
  6034.  
  6035. case 'd':
  6036. defn_mask.outer_macros= NOT(PRN_OUTER_MACROS);
  6037. break;
  6038.  
  6039. case 'f':
  6040. defn_mask.formats= NOT(PRN_fORMATS);
  6041. break;
  6042.  
  6043. case 'F':
  6044. defn_mask.Formats= NOT(PRN_FORMATS);
  6045. break;
  6046.  
  6047. case 'l':
  6048. defn_mask.limbo= NOT(PRN_LIMBO);
  6049. break;
  6050.  
  6051. case 'm':
  6052. defn_mask.macros= NOT(PRN_MACROS);
  6053. break;
  6054.  
  6055. case 'v':
  6056. defn_mask.v= NOT(PRN_V);
  6057. break;
  6058.  
  6059. case 'w':
  6060. case 'W':
  6061. defn_mask.w= NOT(PRN_W);
  6062. break;
  6063.  
  6064. default:
  6065. bad_option();
  6066. break;
  6067. }
  6068. }
  6069.  
  6070.  
  6071. break;
  6072.  
  6073. case 'x':
  6074. flags3(BOOLEAN(not));
  6075. break;
  6076.  
  6077. case 'X':
  6078. flags3(BOOLEAN(!not));
  6079. break;
  6080.  
  6081. case 'y':
  6082.  
  6083. {
  6084. outer_char abbrev[80],HUGE*a;
  6085. BUF_SIZE nunits;
  6086. MEM HUGE*m,HUGE*mmin= NULL,HUGE*mmax= NULL;
  6087. boolean query_mode= NO;
  6088.  
  6089.  
  6090.  
  6091. cant_negate(pa-2);
  6092.  
  6093.  
  6094.  
  6095. if(!*pa)
  6096. {/* Query everything. */
  6097. mmin= mem;
  6098. mmax= mmin+(sizeof_mem/sizeof(MEM)-1);
  6099. query_mode= YES;
  6100. puts("Default memory allocation parameters:");
  6101. }
  6102. else
  6103. {/* Abbreviation specified. */
  6104. abbrev[0]= abbrev[1]= '\0';/* Ensure the abbreviation gets \
  6105.         terminated properly. */
  6106.  
  6107. for(a= abbrev;isalpha(*pa);)
  6108. *a++= *pa++;
  6109.  
  6110. TERMINATE(abbrev,2);/* Max of two character abbreviation. */
  6111.  
  6112. if(!isdigit(*pa))
  6113. {/* Assume it's a question. */
  6114. mmin= msearch(abbrev,0L);
  6115. mmax= mmin+1;
  6116. query_mode= YES;
  6117. }
  6118. }
  6119.  
  6120. if(query_mode)
  6121. for(m= mmin;m<mmax;m++)
  6122. printf(" \"%-s\"%s x %d byte(s):\
  6123.   min = %lu, current = %lu [%lu byte(s)], max = %lu.\n",
  6124. (char*)m->abbrev,m->abbrev[1]?"":" ",
  6125. m->bytes,
  6126. m->min,m->nunits,(m->nunits)*(m->bytes),m->max);
  6127. else
  6128. {/* Change setting. */
  6129. nunits= ATOL(pa);
  6130. msearch(abbrev,nunits);/* Set the value. */
  6131. }
  6132.  
  6133. info_option= YES;
  6134. }
  6135.  
  6136.  
  6137. break;
  6138.  
  6139. case 'z':
  6140.  
  6141. {
  6142.  
  6143. cant_negate(pa-2);
  6144.  
  6145.  
  6146.  
  6147. if(STRLEN(pa)<MAX_FILE_NAME_LENGTH)
  6148. {
  6149. if(STRCMP(pa,".")==0)
  6150. {/* Read default file in current directory. */
  6151. if(
  6152. nsprintf(style_file_name,OC(".%c%s"),2,PREFIX_END_CHAR,STYLE_FILE_NAME)>=
  6153. MAX_FILE_NAME_LENGTH)OVERFLW("./style_file_name","");
  6154. }
  6155. else
  6156. STRCPY(style_file_name,pa);
  6157.  
  6158. renamed_style= YES;
  6159. }
  6160. else
  6161. err0_print(ERR_C,OC("Style file name too long; must be less \
  6162. than %d characters"),1,MAX_FILE_NAME_LENGTH);
  6163. }
  6164.  
  6165.  
  6166.  
  6167. break;
  6168.  
  6169. case 'Z':
  6170. prn_style_defaults= BOOLEAN(!not);
  6171. style_args= pa;
  6172. info_option= YES;
  6173. break;
  6174.  
  6175. case '.':
  6176. dot_constants= NOT(DOT_CONSTANTS);
  6177. break;
  6178.  
  6179. case '\\':
  6180. bslash_continued_strings= NOT(BSLASH_CONTINUED_STRINGS);
  6181. break;
  6182.  
  6183. case '?':
  6184. chk_stmts= NOT(CHK_STMTS);
  6185. break;
  6186.  
  6187. case '[':
  6188. translate_brackets= NOT(TRANSLATE_BRACKETS);
  6189. break;
  6190.  
  6191. case '(':
  6192. case ')':
  6193. chk_ifelse= NOT(CHK_IFELSE);break;
  6194.  
  6195. case '>':
  6196. case '=':
  6197.  
  6198. cant_negate(pa-2);
  6199.  
  6200.  
  6201. if(doing_cmd_line||phase==2)
  6202. redirect_output();
  6203. break;
  6204.  
  6205. case '/':
  6206. params.CPP_comments[LN(FORTRAN)]
  6207. = params.CPP_comments[LN(FORTRAN_90)]
  6208. = params.CPP_comments[LN(RATFOR)]
  6209. = params.CPP_comments[LN(RATFOR_90)]
  6210. = BOOLEAN(YES^not);
  6211. break;
  6212.  
  6213. case '!':
  6214. params.Point_comments[LN(FORTRAN)]
  6215. = params.Point_comments[LN(FORTRAN_90)]
  6216. = params.Point_comments[LN(RATFOR)]
  6217. = params.Point_comments[LN(RATFOR_90)]
  6218. = BOOLEAN(YES^not);
  6219. break;
  6220.  
  6221. case '+':
  6222. compound_assignments= NOT(COMPOUND_ASSIGNMENTS);break;
  6223.  
  6224. case '#':
  6225. line_info= NOT(LINE_INFO);break;
  6226.  
  6227. default:
  6228. bad_option();
  6229. break;
  6230. }
  6231. }
  6232.  
  6233.  
  6234. ;
  6235. }
  6236. }
  6237.  
  6238.  
  6239.  
  6240. SRTN
  6241. opt_args FCN((l))
  6242. ASCII l C1("")
  6243. {
  6244. ASCII arg_buffer[ARG_BUFFER_SIZE],*pa= arg_buffer,
  6245. *arg_buffer_end= arg_buffer+ARG_BUFFER_SIZE;
  6246. int argc;
  6247. outer_char HUGE*args[MAX_ARGS];
  6248.  
  6249. ini_language(l);/* Set language and initialize flags. */
  6250.  
  6251. if(!IS_WHITE(*loc))
  6252. {
  6253. if(*loc!=0133)
  6254. {/* Unbracketed command, as in \.{@c++}. */
  6255. *pa++= 055;/* Make it an honest command. */
  6256. *pa++= l;/* Don't forget the language. */
  6257.  
  6258. WHILE()
  6259. {
  6260. if(IS_WHITE(*loc)||*loc==0133)break;
  6261. if(*loc==0174&&parsing_mode==INNER)
  6262. {
  6263.  
  6264. err0_print(ERR_C,OC("WARNING:  Code mode ended during \
  6265. unbracketed optional argument.  Should there be white space after \
  6266. language command?"),0);
  6267. break;
  6268. }
  6269. COPY_TO_ARG_BUFFER(*loc++);
  6270. }
  6271. }
  6272.  
  6273. /* We allow bracketed commands to follow unbracketed ones. */
  6274. if(*loc==0133)
  6275. {
  6276. COPY_TO_ARG_BUFFER(040);
  6277.  
  6278. for(loc++;;)
  6279. {/* Skip the opening bracket; copy contents. */
  6280. if(*loc==0135)
  6281. {
  6282. loc++;/* Skip the ending bracket. */
  6283. break;
  6284. }
  6285. COPY_TO_ARG_BUFFER(*loc++);
  6286. }
  6287. }
  6288.  
  6289. TERMINATE(pa,0);/* Terminate |arg_buffer|. */
  6290. argc= to_args(to_outer(arg_buffer),args,MAX_ARGS);
  6291. do_args(NO,argc,args,&found_web,(outer_char*)NULL,&found_change);
  6292. }
  6293.  
  6294. fin_language();/* Do any further flag setup. */
  6295. }
  6296.  
  6297.  
  6298.  
  6299. SRTN
  6300. ini_language FCN((l))
  6301. ASCII l C1("Basic language code")
  6302. {
  6303. /* First we set the language. */
  6304. switch(l)
  6305. {
  6306.  
  6307. case 0143:case 0103
  6308.  
  6309. :
  6310. language= (Cpp?C_PLUS_PLUS:C);
  6311. break;
  6312.  
  6313.  
  6314. case 0162:case 0122
  6315.  
  6316. :
  6317. if(!RAT_OK("Invalid @r command; language set to C"))language= C;
  6318. else language= (Fortran88?RATFOR_90:RATFOR);
  6319. break;
  6320.  
  6321.  
  6322. case 0156:case 0116
  6323.  
  6324. :
  6325. language= (Fortran88?FORTRAN_90:FORTRAN);
  6326. break;
  6327.  
  6328.  
  6329. case 0166:case 0126
  6330.  
  6331.  
  6332.  
  6333. :
  6334. language= LITERAL;
  6335. break;
  6336.  
  6337.  
  6338. case 0170:case 0130
  6339.  
  6340. :
  6341. language= TEX;
  6342. break;
  6343. }
  6344.  
  6345. /* The following is for checking an override of the command-line language \
  6346. in the limbo section. */
  6347. if(doing_cmd_line)cmd_language= language;
  6348.  
  6349. ini0_language();
  6350. }
  6351.  
  6352.  
  6353.  
  6354. SRTN
  6355. ini0_language(VOID)
  6356. {
  6357. /* Set the output language. */
  6358. out_language= OUT_LANGUAGE(language);
  6359.  
  6360. /* Storing these numbers cuts down on the overhead of function calls.  It \
  6361. also enables us to use the macros in the following |switch| properly. */
  6362. language_index= (short)lan_index(language);/* Maybe no longer used. */
  6363. language_num= (short)lan_num(language);
  6364.  
  6365. index_flag= YES;/* Most languages will cross-reference. */
  6366.  
  6367. switch(language)
  6368. {
  6369. case C:
  6370. Cpp= NO;
  6371. break;
  6372.  
  6373. case C_PLUS_PLUS:
  6374. Cpp= YES;/* Just a shorthand for |language==CPP|. */
  6375. break;
  6376.  
  6377. case FORTRAN:
  6378. case FORTRAN_90:
  6379. free_form_input= global_params.Free_form_input[language_num];
  6380. /* This can be turned on by the \.{-n\\} or \.{-n\&} options. */
  6381. auto_semi= global_params.Auto_semi[language_num];
  6382. break;
  6383.  
  6384. case RATFOR:
  6385. case RATFOR_90:
  6386. if(nuweb_mode)
  6387.  
  6388. err0_print(ERR_C,OC("SORRY, but Ratfor doesn't work yet with the N \
  6389. mode!"),0);
  6390. auto_semi= global_params.Auto_semi[language_num];
  6391. if(auto_semi)free_form_input= NO;
  6392. break;
  6393.  
  6394. case LITERAL:
  6395. nuweb_mode= YES;
  6396. line_info= NO;
  6397. index_flag= NO;
  6398. break;
  6399.  
  6400. case TEX:
  6401. break;
  6402.  
  6403. default:
  6404. break;
  6405. }
  6406. }
  6407.  
  6408.  
  6409.  
  6410. SRTN
  6411. fin_language(VOID)
  6412. {
  6413. ini_reserved(language);
  6414.  
  6415. switch(language)
  6416. {
  6417. case C:
  6418. break;
  6419.  
  6420. case RATFOR:
  6421. break;
  6422.  
  6423. case FORTRAN:
  6424. break;
  6425.  
  6426. case LITERAL:
  6427. break;
  6428.  
  6429. case TEX:
  6430. break;
  6431.  
  6432. default:
  6433. break;
  6434. }
  6435.  
  6436. frz_params();/* Make any local parameters. */
  6437.  
  6438. /* Output file name.  For |program == weave|, |out_file == tex_file| by a \
  6439. macro definition in \.{typedefs.hweb}. */
  6440. if(program==tangle)
  6441. out_file= params.outp_file[lan_num(out_language)];
  6442. }
  6443.  
  6444.  
  6445.  
  6446. SRTN
  6447. frz_params(VOID)
  6448. {
  6449.  
  6450. cont_char= XORD(in_escape);/* Current continuation character (in |ASCII|). */
  6451. free_90= BOOLEAN(Fortran88&&free_form_input);
  6452. free_Fortran= BOOLEAN((language==FORTRAN_90)&&free_90);
  6453.  
  6454. if(is_FORTRAN_(language))
  6455. auto_semi= BOOLEAN(!free_Fortran);
  6456.  
  6457. if(program==tangle&&free_90)
  6458. switch(language)
  6459. {
  6460. case FORTRAN_90:
  6461. case RATFOR_90:
  6462. begin_comment_char[lan_num(FORTRAN_90)]= 
  6463. (outer_char)CHOICE(free_90,'!','C');
  6464. break;
  6465.  
  6466. default:;
  6467. }
  6468.  
  6469. }
  6470.  
  6471.  
  6472.  
  6473. int
  6474. to_args FCN((p,args,max_args))
  6475. outer_char HUGE*p C0("")
  6476. outer_char HUGE*args[]C0("")
  6477. int max_args C1("")
  6478. {
  6479. int n;
  6480.  
  6481. for(n= 0;*p;p++)
  6482. {
  6483. if(n>=max_args)
  6484. {
  6485.  
  6486. err0_print(ERR_C,OC("Too many command-line or optional \
  6487. arguments; must be < %d"),1,max_args);
  6488. break;
  6489. }
  6490. while(isspace(*p))p++;/* Skip leading white space. */
  6491. args[n++]= p;/* Record start and count. */
  6492.  
  6493. for(p++;*p;p++)
  6494. if(isspace(*p)||!*p)break;/* Find end of argument. */
  6495.  
  6496. if(!*p)break;/* Get out at end of line. */
  6497. TERMINATE(p,0);/* Mark end of argument. */
  6498. }
  6499.  
  6500. return n;/* Number of arguments found. */
  6501. }
  6502.  
  6503.  
  6504.  
  6505. SRTN
  6506. help(VOID)
  6507. {
  6508. puts("! For help, please see the texinfo entry for FWEB or use options\n\
  6509.  '-@' (query control codes),\n\
  6510.  '-D' (query reserved words),\n\
  6511.  '-y' (query memory allocations),\n\
  6512.  '-Z' (query style-file parameters).");
  6513.  
  6514. usage("",NO);/* In lieu of anything better. */
  6515. }
  6516.  
  6517.  
  6518.  
  6519.  
  6520. SRTN
  6521. FR_args FCN((Language))
  6522. LANGUAGE Language C1("")
  6523. {
  6524. int lnum;
  6525.  
  6526.  
  6527. cant_negate(pa-2);
  6528.  
  6529.  
  6530.  
  6531. if(isdigit(*pa))
  6532. switch(*pa++)
  6533. {/* Options \.{-n7} or \.{-n9}. */
  6534. case '7':
  6535. Fortran88= NO;
  6536. ini_language(XORD(*LANGUAGE_CODE(Language)));
  6537. break;
  6538.  
  6539. case '9':
  6540. Fortran88= YES;
  6541. ini_language(XORD(*LANGUAGE_CODE(Language)));
  6542. break;
  6543.  
  6544. default:
  6545. bad_loption(Language);break;
  6546. }
  6547. else
  6548. {
  6549. lnum= lan_num(language);/* We need to set this so that we can \
  6550. access the language arrays  properly. ??? |language| ??? Used to be |Language| */
  6551.  
  6552. switch(*pa++)
  6553. {
  6554. case '\\':
  6555. case '&':
  6556. /* Set the continuation character; for \Fortran, turn on \
  6557. free-form syntax. */
  6558. if(is_FORTRAN_(Language))
  6559. params.Free_form_input[lnum]= NOT(FREE_FORTRAN);
  6560. params.In_escape[lnum]= *(pa-1);/* Continuation character. */
  6561. break;
  6562.  
  6563. case ';':
  6564. params.Auto_semi[lnum]= BOOLEAN(YES^not);
  6565. break;
  6566.  
  6567. case ':':
  6568. if(is_FORTRAN_(Language))
  6569. Fortran_label= NOT(FORTRAN_LABEL);
  6570. break;
  6571.  
  6572. case '!':
  6573. params.Point_comments[lnum]= BOOLEAN(YES^not);
  6574. break;
  6575.  
  6576. case '/':
  6577. params.CPP_comments[lnum]= BOOLEAN(YES^not);
  6578. break;
  6579.  
  6580. case ')':
  6581. params.Reverse_indices[lnum]= BOOLEAN(YES^not);
  6582. break;
  6583.  
  6584. case 'b':
  6585. case 'B':
  6586. params.Block_nums[lnum]= NOT(BLOCK_NUMS);break;
  6587.  
  6588. case 'g':
  6589. case 'G':
  6590.  
  6591. {
  6592. if(is_RATFOR_(Language))
  6593. {
  6594. if(!RAT_OK("'g' command ignored"))break;
  6595.  
  6596. {
  6597. while(*pa)
  6598. if(isalpha(*pa))
  6599. switch(*pa++)
  6600. {
  6601. case 'r':
  6602. case 'R':
  6603. g_ratio= STRTOD(pa,&pa);
  6604. if(g_ratio<MIN_G_RATIO)
  6605. {
  6606.  
  6607. err0_print(ERR_C,OC(
  6608. "Invalid 'g' option: %s must be >= %.1f"),2,"g_ratio",MIN_G_RATIO);
  6609. g_ratio= G_RATIO;
  6610. };
  6611. break;
  6612. case 'm':
  6613. case 'M':
  6614. marginal_cases= 
  6615. (unsigned short)STRTOL(pa,&pa,10);
  6616. if(marginal_cases<MIN_MARGINAL_CASES)
  6617. {
  6618.  
  6619. err0_print(ERR_C,OC("Invalid 'g' option: %s must be >= %d"),2,"marginal_cases",MIN_MARGINAL_CASES);
  6620. marginal_cases= MARGINAL_CASES;
  6621. };
  6622. break;
  6623. case 's':
  6624. case 'S':
  6625. max_spread= STRTOL(pa,&pa,10);
  6626. if(max_spread<MIN_MAX_SPREAD)
  6627. {
  6628.  
  6629. err0_print(ERR_C,OC("Invalid 'g' option: %s must be >= %d"),2,"max_spread",MIN_MAX_SPREAD);
  6630. max_spread= MAX_SPREAD;
  6631. };
  6632. break;
  6633. default:
  6634.  
  6635. err0_print(ERR_C,OC("Invalid 'g' option: \
  6636. parameter type '%c'"),1,*(pa-1));
  6637. break;
  6638. }
  6639. }
  6640.  
  6641. ;
  6642. }
  6643. else bad_loption(Language);
  6644. }
  6645.  
  6646.  
  6647. break;
  6648.  
  6649. case 'k':
  6650. suppress_cmds= BOOLEAN(YES^not);
  6651.  
  6652. {
  6653. if(!*pa)STRCPY(abbrev_cmds,"*");
  6654. else STRNCPY(abbrev_cmds,pa,NUM_RATFOR_CMDS);
  6655. }
  6656.  
  6657.  
  6658.  
  6659. break;
  6660.  
  6661. case 'K':
  6662. suppress_cmds= BOOLEAN(NO^not);
  6663.  
  6664. {
  6665. if(!*pa)STRCPY(abbrev_cmds,"*");
  6666. else STRNCPY(abbrev_cmds,pa,NUM_RATFOR_CMDS);
  6667. }
  6668.  
  6669.  
  6670.  
  6671. break;
  6672.  
  6673. case 'p':
  6674. if(is_FORTRAN_(Language))prn_semis= NOT(PRN_SEMIS);
  6675. break;
  6676.  
  6677. case '{':
  6678. pa--;
  6679. set_filter(Language);
  6680. break;
  6681.  
  6682. case '\0':
  6683. /* Specify the language.  Note that the other commands don't. */
  6684. ini_language(XORD(*LANGUAGE_CODE(Language)));
  6685. break;
  6686.  
  6687. default:
  6688. bad_loption(Language);
  6689. break;
  6690. }
  6691. }
  6692. }
  6693.  
  6694.  
  6695.  
  6696.  
  6697. SRTN
  6698. save_macro FCN((cmd,t))
  6699. CONST outer_char HUGE*cmd C0("Name of the ``at'' command to put first.")
  6700. outer_char HUGE*t C1("Text of the definition.")
  6701. {
  6702. eight_bits HUGE*p;
  6703. boolean replace_equals= BOOLEAN(STRCMP(cmd,"m")==0);/* For macros, if an \
  6704.     equals sign appears before a space, it will be turned into a space. */
  6705.  
  6706. if(program==weave)return;
  6707.  
  6708. p= mp;
  6709.  
  6710. /* Place command such as \.{@m} into buffer. */
  6711. *mp++= '@';
  6712.  
  6713. while(*cmd)
  6714. *mp++= *cmd++;/* Copy text of command. */
  6715.  
  6716. *mp++= ' ';
  6717.  
  6718. while(*t)
  6719. {
  6720. if(replace_equals)
  6721. if(*t=='=')
  6722. {
  6723. *t= ' ';
  6724. replace_equals= NO;
  6725. }
  6726. else if(*t==' ')replace_equals= NO;
  6727. *mp++= *t++;
  6728. }
  6729.  
  6730. *mp++= ' ';
  6731. *mp= '@';*(mp+1)= 'm';
  6732.  
  6733. /* After we've built it, convert to internal notation. */
  6734. for(;p<mp+2;p++)
  6735. *p= XORD(*p);
  6736. }
  6737.  
  6738.  
  6739.  
  6740. SRTN
  6741. divert FCN((buffer,end,stop))
  6742. ASCII HUGE*buffer C0("Start of the buffer.")
  6743. ASCII HUGE*end C0("End of the buffer.")
  6744. boolean stop C1("Stop when end is reached?")
  6745. {
  6746. stop_the_scan= stop;
  6747.  
  6748. fbuffer= cur_buffer;
  6749. flimit= limit;
  6750. floc= loc;
  6751.  
  6752. cur_buffer= loc= buffer;
  6753. limit= end;
  6754.  
  6755. from_buffer= YES;
  6756. }
  6757.  
  6758.  
  6759. SRTN undivert(VOID)
  6760. {
  6761. cur_buffer= fbuffer;
  6762. limit= flimit;
  6763. loc= floc;
  6764.  
  6765. from_buffer= NO;
  6766. }
  6767.  
  6768.  
  6769.  
  6770.  
  6771. SRTN
  6772. mem_avail FCN((at_end))
  6773. int at_end C1("0 for beginning, 1 for end")
  6774. {
  6775. if(at_end)
  6776. printf("\n Allocated maximum of %lu bytes dynamically; \
  6777. ended with %lu bytes.\n",max_mem,total_mem);
  6778.  
  6779. #if PRINT_AVAILABLE_MEMORY
  6780. printf(" Available memory: %lu bytes.\n",CORE_LEFT);
  6781. if(!at_end)
  6782. {
  6783. starting_memory= CORE_LEFT;/* Used in |smin0|. */
  6784. putchar('\n');
  6785. }
  6786. #endif
  6787. }
  6788.  
  6789.  
  6790.  
  6791. SRTN
  6792. stat0 FCN((name,size,num,max_num,abs_max_num,abbrev,ctrl_chars))
  6793. CONST outer_char*name C0("")
  6794. size_t size C0("")
  6795. BUF_SIZE num C0("")
  6796. BUF_SIZE max_num C0("")
  6797. BUF_SIZE abs_max_num C0("")
  6798. CONST outer_char*abbrev C0("")
  6799. CONST outer_char*ctrl_chars C1("")
  6800. {
  6801. printf("  %s [\"%s\"] x %u byte(s):  %lu [%lu byte(s)] of %lu <= %lu%s\n",
  6802. (char*)name,(char*)abbrev,(unsigned)size,num,num*size,max_num,
  6803. abs_max_num,(char*)ctrl_chars);
  6804. }
  6805.  
  6806.  
  6807.  
  6808. BUF_SIZE
  6809. smin0 FCN((abs_max_num))
  6810. BUF_SIZE abs_max_num C1("")
  6811. {
  6812. return MIN(starting_memory,abs_max_num);
  6813. }
  6814.  
  6815.  
  6816.  
  6817.  
  6818. SRTN
  6819. ntrunc(VOID)
  6820. {
  6821. LANGUAGE l;
  6822.  
  6823. truncate_ids= NO;
  6824.  
  6825. if(!*pa)goto bad_t_option;
  6826.  
  6827. while(*pa)
  6828. {
  6829. if(isdigit(*pa))
  6830. l= (language==NO_LANGUAGE)?GLOBAL_LANGUAGE:language;
  6831. else switch(*pa++)
  6832. {
  6833.  
  6834. case 'c':case 'C'
  6835.  
  6836. :
  6837. l= lcase(C,'\0',C_PLUS_PLUS,'+',&pa);
  6838. break;
  6839.  
  6840. case 'r':case 'R'
  6841.  
  6842. :
  6843. l= lcase(RATFOR,'7',RATFOR_90,'9',&pa);
  6844. break;
  6845.  
  6846. case 'n':case 'N'
  6847.  
  6848. :
  6849. l= lcase(FORTRAN,'7',FORTRAN_90,'9',&pa);
  6850. break;
  6851.  
  6852. case 'v':case 'V'
  6853.  
  6854.  
  6855.  
  6856. :
  6857. l= LITERAL;break;
  6858.  
  6859. case 'x':case 'X'
  6860.  
  6861. :
  6862. l= TEX;break;
  6863. default:
  6864. bad_t_option:
  6865.  
  6866. err0_print(ERR_C,OC("Invalid -t option.  Example:  `-tn=6{_}'"),0);
  6867. return;
  6868. }
  6869.  
  6870. /* Skip over optional equals sign. */
  6871. if(*pa==LANGUAGE_SEPARATOR)pa++;
  6872.  
  6873. /* Set the maximum identifier length for language~|l|. */
  6874. truncate_ids= 
  6875. BOOLEAN(CHOICE((tr_max[lan_num(l)]= (unsigned short)ATOI(pa))!=0,
  6876. YES,NO));
  6877.  
  6878. while(isdigit(*pa))pa++;/* Skip over the integer. */
  6879.  
  6880. if(*pa=='{')set_filter(l);
  6881. }
  6882. }
  6883.  
  6884.  
  6885.  
  6886. LANGUAGE
  6887. lcase FCN((l0,c0,l1,c1,pp))
  6888. LANGUAGE l0 C0("")
  6889. outer_char c0 C0("")
  6890. LANGUAGE l1 C0("")
  6891. outer_char c1 C0("")
  6892. outer_char HUGE*HUGE*pp C1("")
  6893. {
  6894. if(c0&&**pp==c0)
  6895. {
  6896. while(**pp==c0)(*pp)++;
  6897. return l0;
  6898. }
  6899.  
  6900. if(c1&&**pp==c1)
  6901. {
  6902. while(**pp==c1)(*pp)++;
  6903. return l1;
  6904. }
  6905.  
  6906. return l0;
  6907. }
  6908.  
  6909.  
  6910.  
  6911. SRTN
  6912. set_filter FCN((Language))
  6913. LANGUAGE Language C1("")
  6914. {
  6915. if(!*pa)return;/* In case there's no argument following the language cmd. */
  6916.  
  6917. if(*pa=='{')pa++;
  6918.  
  6919. filter_char[lan_num(Language)]= (char*)pa;/* Repoint to the string of \
  6920.                 characters following this command. */
  6921.  
  6922. /* Remove the closing bracket from the list. */
  6923. for(;*pa;pa++)
  6924. if(*pa=='}')
  6925. {
  6926. *pa++= '\0';
  6927. return;
  6928. }
  6929. }
  6930.  
  6931.  
  6932.  
  6933.  
  6934. SRTN
  6935. flags3 FCN((not))
  6936. boolean not C1("")
  6937. {
  6938. prn_contents= BOOLEAN(PRN_CONTENTS^not);
  6939. prn_index= BOOLEAN(PRN_INDEX^not);
  6940. prn_modules= BOOLEAN(PRN_MODULES^not);
  6941. xref_unnamed= BOOLEAN(XREF_UNNAMED^not);
  6942.  
  6943. if(!(*pa))
  6944. {/* No argument.  Assume nothing is to be printed. */
  6945. *pa= '*';
  6946. *(pa+1)= '\0';
  6947. }
  6948.  
  6949. for(;*pa;pa++)
  6950. switch(*pa)
  6951. {
  6952. case '*':
  6953. case '/':
  6954. prn_contents= NOT(PRN_CONTENTS);
  6955. prn_index= NOT(PRN_INDEX);
  6956. prn_modules= NOT(PRN_MODULES);
  6957. break;
  6958.  
  6959. case 'C':
  6960. case 'c':
  6961. prn_contents= NOT(PRN_CONTENTS);
  6962. break;
  6963.  
  6964. case 'I':
  6965. case 'i':
  6966. prn_index= NOT(PRN_INDEX);
  6967. break;
  6968.  
  6969. case 'M':
  6970. case 'm':
  6971. prn_modules= NOT(PRN_MODULES);
  6972. break;
  6973.  
  6974. case 'u':
  6975. xref_unnamed= NOT(XREF_UNNAMED);
  6976. break;
  6977.  
  6978. default:
  6979.  
  6980. err0_print(ERR_C,OC("'%c' is invalid argument for -x; must be \
  6981. element of set {*cim}"),1,*pa);
  6982. break;
  6983. }
  6984.  
  6985. no_xref= BOOLEAN(!(prn_index||prn_modules));
  6986. }
  6987.  
  6988.  
  6989.  
  6990. SRTN
  6991. redirect_output(VOID)
  6992. {
  6993. int k;
  6994.  
  6995. if(*pa=='\0')
  6996. {/* Empty argument; send stuff to |stdout|. */
  6997. new_fname(&tex_fname,OC("stdout"),NULL);
  6998.  
  6999. for(k= 0;k<NUM_LANGUAGES;k++)
  7000. new_fname(params.outp_nm+k,OC("stdout"),NULL);
  7001. }
  7002. else if(phase==2&&program==weave)
  7003. return;
  7004. else
  7005. {
  7006. outer_char c,HUGE*pname;
  7007. outer_char HUGE*q= (outer_char HUGE*)STRCHR(pa,LANGUAGE_SEPARATOR);
  7008. /* Is there an '='? */
  7009.  
  7010. if(q==pa)
  7011. {/* ``\.{->=new\_name}'' */
  7012. c= LANGUAGE_SEPARATOR;
  7013. pname= q+1;/* Point to file name. */
  7014. }
  7015. else if(q)
  7016. {/* ``\.{->c=new\_name}'' */
  7017. c= *pa++;/* Language symbol. */
  7018. pname= q;/* Point to \.=. */
  7019. }
  7020. else
  7021. {/* ``\.{->new\_name}'' */
  7022. c= LANGUAGE_SEPARATOR;
  7023. pname= pa;/* Point to file name. */
  7024. }
  7025.  
  7026. switch(c)
  7027. {
  7028.  
  7029. case 'c':case 'C'
  7030.  
  7031. :
  7032. set_fname(lcase(C,'\0',C_PLUS_PLUS,'+',&pa),pname,YES);
  7033. break;
  7034.  
  7035.  
  7036. case 'r':case 'R'
  7037.  
  7038. :
  7039. if(!RAT_OK("Redirection ignored"))break;
  7040.  
  7041. set_fname(lcase(RATFOR,'7',RATFOR_90,'9',&pa),pname,YES);
  7042. break;
  7043.  
  7044.  
  7045. case 'n':case 'N'
  7046.  
  7047. :
  7048. set_fname(lcase(FORTRAN,'7',FORTRAN_90,'9',&pa),pname,YES);
  7049. break;
  7050.  
  7051.  
  7052. case 'v':case 'V'
  7053.  
  7054.  
  7055.  
  7056. :
  7057. set_fname(LITERAL,pname,YES);
  7058. break;
  7059.  
  7060.  
  7061. case 'x':case 'X'
  7062.  
  7063. :
  7064. set_fname(TEX,pname,YES);
  7065. break;
  7066.  
  7067. case LANGUAGE_SEPARATOR:
  7068. #if 0 /* Don't want to do this; it screws up module labeling for \FWEAVE. */
  7069. new_fname(&tex_fname,pname,NULL);
  7070. #endif
  7071.  
  7072. for(k= 0;k<NUM_LANGUAGES;k++)
  7073. new_fname(params.outp_nm+k,pname,NULL);
  7074.  
  7075. break;
  7076.  
  7077. default:
  7078.  
  7079. err0_print(ERR_C,OC("Syntax error in output redirection \
  7080. command \"->\". Language must be one of 'c', 'r', 'n', `m', or `x',  not '%c'"),1,*(pa-1));
  7081. break;
  7082. }
  7083. }
  7084. }
  7085.  
  7086.  
  7087.  
  7088. SRTN
  7089. set_fname FCN((l,s,check))
  7090. LANGUAGE l C0("Language")
  7091. outer_char HUGE*s C0("Remainder of command-line argument to parse")
  7092. boolean check C1("Do we check for beginning colon?")
  7093. {
  7094. if(program==weave)
  7095.  
  7096. err0_print(ERR_C,OC("Can't redirect FWEAVE's TeX output by individual \
  7097. languages. Use \"->\" or \"-%cname.ext\""),1,LANGUAGE_SEPARATOR);
  7098.  
  7099. if(check)
  7100. if(*s++!=LANGUAGE_SEPARATOR)
  7101. {
  7102.  
  7103. err0_print(ERR_C,OC("Expected '%c' after language in \"->\"; \
  7104. command ignored"),1,LANGUAGE_SEPARATOR);
  7105. return;
  7106. }
  7107.  
  7108. /* If the name begins with a '\.\#', it's filled in later with |wbflnm0|. */
  7109. new_fname(params.outp_nm+lan_num(l),*s?s:(outer_char HUGE*)"stdout",NULL);
  7110. }
  7111.  
  7112.  
  7113.  
  7114.  
  7115. SRTN
  7116. cant_negate FCN((s))
  7117. outer_char HUGE*s C1("")
  7118. {
  7119. if(not)
  7120. {
  7121. printf("! Can't negate option \"%s\"'; ignoring extra hyphen.\n",
  7122. (char*)s);
  7123. mark_harmless;
  7124. }
  7125. }
  7126.  
  7127.  
  7128.  
  7129. SRTN
  7130. bad_lcmd FCN((type,pa0))
  7131. CONST char*type C0("")
  7132. CONST outer_char HUGE*pa0 C1("")
  7133. {
  7134.  
  7135. err0_print(ERR_C,OC("Invalid language %s \"%s\""),2,type,pa0);
  7136. }
  7137.  
  7138.  
  7139.  
  7140. SRTN
  7141. bad_loption FCN((Language))
  7142. LANGUAGE Language C1("")
  7143. {
  7144. printf("! Invalid language option \"%s\" for %s.\n",
  7145. (char*)(pa-3),is_FORTRAN_(Language)?"Fortran":"Ratfor");
  7146. mark_harmless;
  7147. }
  7148.  
  7149.  
  7150.  
  7151. SRTN
  7152. usage FCN((msg,is_fatal))
  7153. CONST char*msg C0("")
  7154. boolean is_fatal C1("Fatal?")
  7155. {
  7156. outer_char temp[200];
  7157.  
  7158. sprintf((char*)temp,
  7159. "%s!! Usage:  %s webfile[%cweb] [changefile[%cch]] [-option...]\n",
  7160. msg,
  7161. program==tangle?"ftangle":"fweave",
  7162. wt_style.ext_delimiter,wt_style.ext_delimiter);
  7163.  
  7164. if(is_fatal)
  7165. FATAL(NULL,temp,"");
  7166. else
  7167. wrap_up();
  7168. }
  7169.  
  7170.  
  7171.  
  7172. SRTN
  7173. too_long(VOID)
  7174. {
  7175. FATAL(NULL,"!! Filename too long: ",(CONST outer_char*)pa);
  7176. }
  7177.  
  7178.  
  7179.  
  7180. SRTN
  7181. bad_option(VOID)
  7182. {
  7183. printf("! Unknown option \"%s\" ignored.\n",(char*)(pa-2));
  7184. mark_harmless;
  7185. }
  7186.  
  7187.  
  7188.  
  7189. SRTN
  7190. chk_override FCN((language0))
  7191. LANGUAGE language0 C1("")
  7192. {
  7193. if(language!=language0&&cmd_language!=NO_LANGUAGE&&cmd_language!=
  7194. language)
  7195.  
  7196. err0_print(ERR_C,OC("WARNING:  Command-line language %s overridden in limbo by %s"),2,languages[lan_num(cmd_language)],languages[lan_num(language)]);
  7197. }
  7198.  
  7199.  
  7200.  
  7201. SRTN
  7202. new_fname FCN((pname,name,ext))
  7203. outer_char HUGE*HUGE*pname C0("")
  7204. outer_char*name C0("")
  7205. outer_char*ext C1("")
  7206. {
  7207. outer_char temp[MAX_FILE_NAME_LENGTH];
  7208.  
  7209. /* An empty |name| means allocate some space. */
  7210. if(!name)
  7211. *pname= GET_MEM("pname",DFLT_FNAME_LENGTH+1,outer_char);
  7212. else
  7213. {/* Otherwise, we possibly allocate the space and construct the \
  7214. name. */
  7215. char ext_delimiter[2];
  7216. FILE*temp_file_ptr;
  7217.  
  7218. ext_delimiter[0]= (char)wt_style.ext_delimiter;
  7219. ext_delimiter[1]= '\0';
  7220.  
  7221.  
  7222. if(
  7223. nsprintf(temp,OC("%s%s%s"),3,name,ext?
  7224. ext_delimiter:"",ext?ext:(outer_char*)"")>=(int)(MAX_FILE_NAME_LENGTH))OVERFLW("temp","");
  7225.  
  7226. /* Previously we used to reallocate the file name here.  However, that \
  7227. leads to an egregious error, since if the block is actually moved the old \
  7228. pointers are still around on the stack and in various other hiding places. \
  7229. Now, we just allocate a new area if the name is new. */
  7230. was_opened(temp,0,pname,&temp_file_ptr);
  7231. }
  7232. }
  7233.  
  7234.  
  7235.  
  7236. unsigned
  7237. esc_file_name FCN((esc_name,max_length,name))
  7238. outer_char*esc_name C0("Put answer into here")
  7239. unsigned max_length C0("Maximum length of |esc_name|.")
  7240. outer_char*name C1("Put escapes into this name")
  7241. {
  7242. outer_char*pt,*pn;
  7243. unsigned n;
  7244.  
  7245. max_length--;/* Allow room for the final null. */
  7246.  
  7247. for(pt= esc_name,pn= name,n= 0;*pn;)
  7248. {
  7249. if(program==weave)
  7250. switch(*pn)
  7251. {
  7252. case '\\':case '$':case '#':case '%':
  7253. case '^':case '~':case '&':case '_':
  7254. if(n<max_length)
  7255. {
  7256. n++;
  7257. *pt++= '\\';
  7258. }
  7259. }
  7260.  
  7261. if(n<max_length)
  7262. {
  7263. n++;
  7264. *pt++= *pn++;
  7265. }
  7266. }
  7267.  
  7268. TERMINATE(pt,0);
  7269. return n;
  7270. }
  7271.  
  7272.  
  7273.  
  7274. SRTN
  7275. ASCII_file_write FCN((file_ptr,p0,n))
  7276. FILE*file_ptr C0("Standard file pointer.")
  7277. CONST ASCII HUGE*p0 C0("Start of the buffer.")
  7278. size_t n C1("Number of characters to write.")
  7279. {
  7280. CONST ASCII HUGE*p,HUGE*p1= p0+n;
  7281. ASCII atemp[1000],HUGE*a,HUGE*a1;
  7282. size_t n_out;
  7283.  
  7284. if(n==0)
  7285. return;
  7286.  
  7287. /* Translate any special characters into something readable. */
  7288. for(p= p0,a1= atemp;p<p1;a1++,p++)
  7289. switch(*p)
  7290. {
  7291. case interior_semi:
  7292. *a1= 073;
  7293. break;
  7294.  
  7295. case MACRO_ARGUMENT:
  7296. *a1++= 0133;
  7297. *a1++= 0133;
  7298. *a1++= (ASCII)(060+*(++p));
  7299. *a1++= 0135;
  7300. *a1= 0135;
  7301. break;
  7302.  
  7303. default:
  7304. *a1= *p;
  7305. break;
  7306. }
  7307.  
  7308. n= PTR_DIFF(size_t,a1,atemp);
  7309. /* Might be bigger than incoming~|n| because of macro arg. */
  7310.  
  7311. if(translate_ASCII)
  7312. {/* Convert to the outer world. */
  7313. outer_char temp[1000];
  7314. outer_char HUGE*t;
  7315.  
  7316. for(a= atemp,t= temp;a<a1;)
  7317. *t++= XCHR(*a++);
  7318.  
  7319. n_out= FWRITE(temp,n,file_ptr);
  7320. }
  7321. else
  7322. n_out= FWRITE(atemp,n,file_ptr);
  7323.  
  7324. if(n_out!=1)
  7325.  
  7326. {
  7327. char temp[100];
  7328. int errno0= errno;
  7329.  
  7330. sprintf(temp,"! WRITE ERROR: nbytes = %u, %u items written\n",
  7331. (unsigned)n,(unsigned)n_out);
  7332. FATAL(NULL,temp,strerror(errno0));
  7333. }
  7334.  
  7335.  
  7336. }
  7337.  
  7338.  
  7339.  
  7340. #if !HAVE_STRERROR
  7341.  
  7342. char*
  7343. strerror FCN((errnum))
  7344. int errnum C1("")
  7345. {
  7346. static char temp[50];
  7347.  
  7348. sprintf(temp,"(strerror is not available; errno = %d)",errnum);
  7349. return temp;
  7350. }
  7351.  
  7352. #endif /* |!HAVE_STRERROR| */
  7353.  
  7354.  
  7355.  
  7356. struct tm*
  7357. the_localtime(VOID)
  7358. {
  7359. time_t the_tm;
  7360. time_t time PROTO((time_t*tp));
  7361.  
  7362. time(&the_tm);
  7363. return localtime(&the_tm);
  7364. }
  7365.  
  7366.  
  7367.  
  7368. CONST outer_char*
  7369. the_day FCN((t))
  7370. CONST struct tm*t C1("")
  7371. {
  7372. return OC(day[t->tm_wday]);
  7373. }
  7374.  
  7375. #define NDATE 20
  7376.  
  7377. CONST outer_char*
  7378. the_cdate FCN((t))
  7379. CONST struct tm*t C1("")
  7380. {
  7381. static outer_char date_buf[NDATE];
  7382.  
  7383. if(
  7384. nsprintf(date_buf,OC("%s %d, %d"),3,month[t->tm_mon],t->tm_mday,1900+t->tm_year)>=NDATE)
  7385. OVERFLW("Date","");
  7386. return(CONST outer_char*)date_buf;
  7387. }
  7388. #undef NDATE
  7389.  
  7390. #define NTIME 8
  7391.  
  7392. CONST outer_char*
  7393. the_time FCN((t))
  7394. CONST struct tm*t C1("")
  7395. {
  7396. static outer_char time_buf[NTIME];
  7397.  
  7398. if(
  7399. nsprintf(time_buf,OC("%d:%02d"),2,t->tm_hour,t->tm_min)>=NTIME)
  7400. OVERFLW("Time","");
  7401.  
  7402. return(CONST outer_char*)time_buf;
  7403. }
  7404. #undef NTIME
  7405.  
  7406.  
  7407.  
  7408. #if TIMING
  7409.  
  7410. SRTN
  7411. ini_timer(VOID)
  7412. {
  7413. TIME(&time0);
  7414. clock0= clock();
  7415. }
  7416.  
  7417. #endif /* |TIMING| */
  7418.  
  7419.  
  7420.  
  7421. #if TIMING
  7422.  
  7423. SRTN
  7424. prn_time(VOID)
  7425. {
  7426. TIME_T time1;
  7427. double cpu,wall;
  7428. char less_than= NO;
  7429. char format[100];/* We build the format for the time output here. */
  7430.  
  7431. cpu= (clock()-clock0)/(double)(CLOCKS_PER_SEC);
  7432. TIME(&time1);
  7433.  
  7434. /* Because the real time is in units of seconds, we might get~0, so we'll \
  7435. be fancy and print an inequality in that case. */
  7436. if((wall= DIFFTIME(time1,time0))==0.0)
  7437. {
  7438. wall= 1.0;
  7439. less_than= YES;
  7440. }
  7441.  
  7442. SET_COLOR(timing);
  7443.  
  7444. /* --- CPU time --- */
  7445. sprintf(format,"CPU = %%.%df sec.",TIMING_WIDTH);
  7446. printf(format,cpu);
  7447. if(cpu>=60.0)printf(" (%.2f min.)",cpu/60.0);
  7448.  
  7449. /* --- WALL CLOCK time --- */
  7450. sprintf(format,"; REAL %%s %%.%df sec.",TIMING_WIDTH);
  7451. printf(format,less_than?"<=":"=",wall);
  7452. if(wall>=60.0)printf(" (%.2f min.).",wall/60.0);
  7453.  
  7454. /* --- PERCENTAGE CPU UTILIZATION --- */
  7455. printf("  CPU/REAL = %.1f%%.\n",100.0*(cpu/wall));
  7456.  
  7457. /* Debugging message: Check for compatibility. Because the timing routines \
  7458. may not be perfectly compatible through all decimal places, we check only \
  7459. that |cpu <= wall| to an accuracy of tenths of seconds. */
  7460.  
  7461. SET_COLOR(ordinary);
  7462. }
  7463.  
  7464. #endif /* |TIMING| */
  7465.  
  7466.  
  7467.  
  7468. SRTN
  7469. ini_program FCN((program0))
  7470. PROGRAM program0 C1("")
  7471. {
  7472. program= program0;/* Set global flag. */
  7473.  
  7474. the_system= OC(THE_SYSTEM);/* |THE_SYSTEM| is defined in \.{os.hweb}. */
  7475. local_banner= OC(LOCAL_BANNER);/* See \.{os.hweb} and \.{custom.web}. */
  7476.  
  7477. ini_style();/* Default style file initializations. */
  7478. }
  7479.  
  7480.  
  7481.  
  7482. SRTN
  7483. banner(VOID)
  7484. {
  7485.  
  7486. printf("This is %s",DEBUG_XCHR?"ScRaMbLeD ":"");
  7487.  
  7488. printf("%s",program==tangle?"FTANGLE":"FWEAVE");
  7489.  
  7490. printf(" [%s version %s (%s)]. %s\n",
  7491. (char*)the_system,(char*)version,(char*)release_date,
  7492. (char*)local_banner);
  7493. }
  7494.  
  7495.  
  7496.  
  7497. SRTN
  7498. reading FCN((in_name,emit_newline))
  7499. CONST outer_char*in_name C0("")
  7500. boolean emit_newline C1("")
  7501. {
  7502. CLR_PRINTF(info,("Reading"));putchar(' ');
  7503. CLR_PRINTF(in_file,("%s",(char*)in_name));
  7504. CLR_PRINTF(info,("..."));
  7505.  
  7506. if(emit_newline)
  7507. putchar('\n');
  7508. }
  7509.  
  7510.  
  7511.  
  7512. SRTN
  7513. writing FCN((print_write,out_name))
  7514. boolean print_write C0("")
  7515. CONST outer_char*out_name C1("")
  7516. {
  7517. if(print_write)
  7518. {CLR_PRINTF(info,("\nWriting"));putchar(' ');}
  7519. CLR_PRINTF(out_file,("%s",(char*)out_name));
  7520. CLR_PRINTF(info,("..."));
  7521. fflush(stdout);
  7522. }
  7523.  
  7524.  
  7525.  
  7526. SRTN
  7527. progress(VOID)
  7528. {
  7529. if(*(loc-1)==052)
  7530. {/* Found a starred section. */
  7531. if(err_happened)
  7532. {
  7533. putchar('\n');
  7534. err_happened= NO;
  7535. }
  7536. else putchar(' ');
  7537. CLR_PRINTF(module_num,("*%d",module_count));
  7538. }
  7539.  
  7540. UPDATE_TERMINAL;
  7541. }
  7542.  
  7543.  
  7544.  
  7545. int
  7546. nsprintf FCN(VA_ALIST((s,fmt,n VA_ARGS)))
  7547. VA_DCL(
  7548. outer_char*s C0("")
  7549. CONST outer_char*fmt C0("")
  7550. int n C2(""))
  7551. {
  7552. int num_char;
  7553. VA_LIST(arg_ptr)
  7554. #if(NUM_VA_ARGS == 1)
  7555. outer_char*s;
  7556. CONST outer_char*fmt;
  7557. int n;
  7558. #endif
  7559.  
  7560. VA_START(arg_ptr,n);
  7561.  
  7562. #if(NUM_VA_ARGS == 1)
  7563. s= va_arg(arg_ptr,outer_char*);
  7564. fmt= va_arg(arg_ptr,outer_char*);
  7565. va_arg(arg_ptr,int);
  7566. #endif
  7567.  
  7568. #if ANSI_SPRINTF
  7569. num_char= 
  7570. #endif
  7571.  
  7572. vsprintf((char*)s,(CONST char*)fmt,arg_ptr);
  7573.  
  7574. #if !ANSI_SPRINTF
  7575. num_char= (int)STRLEN(s);
  7576. #endif
  7577.  
  7578. va_end(arg_ptr);
  7579.  
  7580. return num_char;
  7581. }
  7582.  
  7583.  
  7584. #endif /* Part 2 */
  7585.  
  7586.  
  7587.  
  7588.  
  7589.  
  7590.  
  7591.