@z --- common.web ---

FWEB version 1.40 (October 30, 1993)

Based on version 0.5 of S. Levy's CWEB [copyright (C) 1987 Princeton University]

@x-----------------------------------------------------------------------------


\Title{COMMON}

@c

@* INTRODUCTION.
This file contains code common to both \.{TANGLE} and
\.{WEAVE}, that roughly concerns the following problems: character
uniformity, input routines, error handling and parsing of command line.  We
have tried to concentrate in this file all the system dependencies, so as
to maximize portability.

\FWEB\ has been written to work with a variety of C~compilers, not
necessarily ANSI. In particular, the special macro tokens~'\.\#'
and~'\.{\#\#}' are not used in any \.{@@d} commands; when such
constructions have been needed, the \WEB\ macro definition~\.{@@m} has been
used. The |enum| feature has been assumed to exist. \CWEB\ did not use
|enum|, so there's a fair amount of inherited \CWEB\ code that should
eventually be changed to |enum|, which makes debugging much easier. This
will be done in future versions. One should study the header files
\.{os.hweb}, \.{proto.hweb}, \.{includes.hweb}, and \.{custom.web} for
further information about machine dependencies.

In the texts below we will sometimes use \.{WEB} to refer to either of the
two component programs, if no confusion can arise.

@m _COMMON_
@d _COMMON_h
@d COMMON_FCNS_

@ Here is the overall appearance of this file:

@d VERSION "1.40"
@d RELEASE "October 30, 1993"

@A
@<Include files@>@;
@<Common code for \.{TANGLE} and \.{WEAVE}@>@;
@<Typedef declarations@>@;
@<Other definitions@>@;
@<Global variables@>@;
@<Functions@>@;

@I typedefs.hweb

@I xrefs.hweb
@I tokens.hweb
@I scraps.hweb
@I stacks.hweb

@
@<Include...@>=
#include "map.h"

@ A dummy module for \.{scraps.hweb}.

@<Rest of |trans_plus| union@>=

@ For personal computers, we sometimes need to initialize the stack size.

@d STKLEN 20000U /* Borland needs this number; Microsoft requires it from
			the compiler line. */

@<Common...@>=

#ifdef ibmpc /* \.{Machine-dependent}: For initializing the stack size. */
	extern unsigned _stklen = STKLEN;
#endif


@* The CHARACTER SET.
One of the main goals in the design of \.{WEB} has been to make it readily
portable between a wide variety of computers. Yet \.{WEB} by its very
nature must use a greater variety of characters than most computer
programs deal with, and character encoding is one of the areas in which
existing machines differ most widely from each other.

To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
to an internal seven-bit code that is essentially standard ASCII, the
``American Standard Code for Information Interchange.''  The conversion
is done immediately when each character is read in. Conversely,
characters are converted from ASCII to the user's external
representation just before they are output.

Such an internal code can be accessed by users of \.{WEB} by means of
constructions like \.{@@'A'}, which should be distinguished from \.{'A'}.
The former is transformed by \.{TANGLE} into an integer that is the
internal code of~\.A, but the latter, a |char| constant, is not touched by
\.{WEB}, and will be interpreted by the compiler according to the machine's
character set. 
@^ASCII code@>

Here is a table of the standard visible ASCII codes (\.{\ } stands for
a blank space):
$$\def\:{\char\count255\global\advance\count255 by 1}
\count255='40
\vbox{
\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
\hbox to 40pt{\it\hfill1\/\hfill}%
\hbox to 40pt{\it\hfill2\/\hfill}%
\hbox to 40pt{\it\hfill3\/\hfill}%
\hbox to 40pt{\it\hfill4\/\hfill}%
\hbox to 40pt{\it\hfill5\/\hfill}%
\hbox to 40pt{\it\hfill6\/\hfill}%
\hbox to 40pt{\it\hfill7\/\hfill}}
\vskip 4pt
\hrule
\def\^{\vrule height 10.5pt depth 4.5pt}
\halign{\hbox to 0pt{\hskip -24pt\WO{\~#}\hfill}&\^
\hbox to 40pt{\tt\hfill#\hfill\^}&
&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
17&\:&\:&\:&\:&\:&\:&\:\cr}
\hrule width 280pt}$$

We introduce new types to distinguish between the transliterated characters
and the characters in the outside world.  Let all ``interesting'' values
that a |char| variable may take lie between |first_text_char| and
|last_text_char|; for the ASCII code we can take |first_text_char=0| and
|last_text_char=0177|. We will tell \.{WEB} to convert all input characters
in this range to its own code, and balk at characters outside the range.
We make two assumptions: |first_text_char>=0| and |char| has room for at
least eight bits.

Following \CWEB, \FWEB\ deals with character constants by prefacing them
with '\.{@@}' if they are to be interpreted as |ASCII|. In \CWEB, \TANGLE\
translated such constants into octal, which makes the output hard to read
while debugging. While this mechanism is necessary for a non-ASCII machine,
it is redundant for an ASCII machine. Thus, for the latter by default
\FWEB\ does not translate |ASCII| character constants. To force it to do
so, use the `\.{-a}' command-line option. For non-ASCII machines, the
translation will always be done.
 

{\bf WARNING:} \FWEB\ has been tested only on an ASCII machine. It is 
100\% likely that some debugging will be necessary for any other kind of
machine; the $|outer_char| \Leftrightarrow |ASCII|$ conversions are only
about 75\% in place at this point. (Even this is a substantial improvement
over \CWEB.)

@^system dependencies@>

@d first_text_char 0 // Lowest interesting value of an |outer_char|.
@d last_text_char 0377 // Highest interesting value of an |outer_char|.

@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
the user's external character set by means of arrays~|xord| and~|xchr|
that are analogous to PASCAL's |ord| and |chr| functions. Thus,
$\hbox{internal\_WEB\_chr} = |xord[@texternal\_chr@>]|$ and
$\hbox{external\_chr} = |xchr[@tinternal\_WEB\_chr@>]|$.

@<Common...@>=

ASCII xord[last_text_char+1]; // Converts input chars.\ to |ASCII|.
#ifdef scramble_ASCII
	ASCII xxord[last_text_char+1];  // For scrambling.
#endif
outer_char xchr[0200]; // Converts output chars.\ from |ASCII|. 

@ Every system supporting \cee\ must be able to read and write the
95~visible characters of standard ASCII above (although not necessarily
using the ASCII codes to represent them).  Conversely, these characters,
plus the newline, are sufficient to write any \cee\ program.  Other
characters are desirable mainly in strings, and they can be referred to by
means of escape sequences like~|'\t'|.

The basic implementation of \.{WEB}, then, only has to assign an~|xord| to
these 95 characters (newlines are swallowed by the reading 
routines).  The easiest way to do this is to assign the characters to
their positions in~|xchr| and then invert the correspondence:

@<Functions...@>=
SRTN common_init(VOID)
{
extern SRTN is_Rat_present PROTO((VOID));
struct tm *t = the_localtime(); /* Initialize the time. */

#if(TRANSLATE_ASCII || DEBUG_XCHR)
	translate_ASCII = YES;  // Force it for the cases that really need it.
#endif

  banner(); // Start-up banner.

  is_Rat_present(); // Find out if the \Ratfor\ package was linked on.

  @<Set up character set translations@>@;
  @<Initialize \TeX\ categories@>;
  @<Initialize static pointers@>;
  predefine_macros(); /* Must be done before parsing the command line, so
the user can undefine or override stuff if desired. */
  @<Initialize flags@>@;

  @<Scan arguments and open output files@>;

/* The next two have to be done after reading the command line. */
  @<Allocate dynamic memory@>@; 
  @<Initialize dynamic pointers@>; 
  @<Execute deferred command-line options@>@;
}

@
@<Set up character set...@>=
{
  STRNCPY(xchr,"                                 !\"#$%&'()*+,-./0123456789\
:;<=>?@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ",
	sizeof(xchr));

/* Interesting ``invisible'' things to output. */
  xchr[tab_mark] = '\t';
  xchr[@'\n'] = '\n';

  @<System-dependent parts of character set@>;
  @<Invert |xchr| to get |xord|@>;
}

@ The following system-independent code makes the |xord| array contain
a suitable inverse to the information in |xchr|.

@<Invert |xchr|...@>= 
@{
  int i; /* to invert the correspondence */

@b
/* Initialize to |ASCII| blanks. */
  for (i=first_text_char; i<=last_text_char; i++) 
	{
	xord[i] = @' ';
#ifdef scramble_ASCII
	xxord[i] = @' ';
#endif
	}

/* The |NUL| and |DEL| characters are left alone! */
  for (i=1; i<0177; i++) 
	{
	xord[(eight_bits)XCHR_[i]] = (ASCII)i;
#ifdef scramble_ASCII
	xxord[(eight_bits)wt_style.xchr[i]] = i;
#endif
	}

#ifdef scramble_ASCII
  for(i=0177; i<=0377; i++)
	xxord[(eight_bits)wt_style.xchr[i]] = i;
#endif

#if(DEBUG_XCHR)
  for(i=0177; i<=0377; i++)
	xord[(eight_bits)XCHR_[i]] = (ASCII)i;
#endif
}

@ Now follow routines that translate |outer_char| strings into |ASCII|.
First, to avoid messing with possibly read-only memory, we have a routine
that allocates new storage for the string.  (Thanks to Thorsten Ohl for
this one.) 

@<Func...@>=
ASCII HUGE *x__to_ASCII FCN((p0))
	CONST outer_char HUGE *p0 C1("Character string to translate.")@;
{
  if(translate_ASCII)
    {
      ASCII HUGE *buffer, HUGE *p;
      CONST outer_char HUGE *q;

      buffer = GET_MEM("x__to_ASCII arg",STRLEN(p0)+1,ASCII);

      for (p = buffer, q = p0; *q; p++, q++)
        *p = XORD(*q);
      *p = '\0';

      return buffer;
    }
  else
    return (ASCII HUGE *)p0;
}

@ For dealing with arrays, we have to |realloc| the space.  (Again, thanks
to Thorsten Ohl.) 
@<Func...@>=
ASCII HUGE *x_to_ASCII FCN((p0))
	CONST outer_char HUGE *p0 C1("Character string to translate.")@;
{
  static size_t bufsiz = 0;
  static ASCII HUGE *buffer = NULL;

  if(translate_ASCII)
    {
      ASCII HUGE *p;
      CONST outer_char HUGE *q;

      while (bufsiz <= STRLEN (p0) + 1)
        {
	  if(buffer == NULL) 
		buffer = GET_MEM("x_to_ASCII_buf",bufsiz=32,ASCII);
/* Some systems don't like a |NULL| argument to |realloc|. */
          else buffer = (ASCII HUGE *) REALLOC(buffer, bufsiz += 32);

          if (buffer == NULL)
            FATAL("!! No more memory (x_to_ASCII)", "");
        }

      for (p = buffer, q = p0; *q; p++, q++)
        *p = XORD(*q);
      *p = '\0';

      return buffer;
    }
  else
    return (ASCII HUGE *)p0;
}

@ Finally, this function converts in place.
@<Func...@>=

ASCII HUGE *to_ASCII FCN((p0))
	outer_char HUGE *p0 C1("Character string to translate.")@;
{
ASCII HUGE *p;

if(translate_ASCII)
	for(p=(ASCII HUGE *)p0; *p; p++) *p = XORD(*p);

return (ASCII HUGE *)p0;
}

@ Here is the inverse routine, converting in place |ASCII| to |outer_char|.
@<Func...@>=

outer_char HUGE *to_outer FCN((p0))
	ASCII HUGE *p0 C1("Internal string to translate to outer world.")@;
{
outer_char HUGE *p;

if(translate_ASCII)
	for(p=(outer_char HUGE *)p0; *p; p++) *p = XCHR(*(ASCII HUGE *)p); 

return (outer_char HUGE *)p0;
}

@ Some \cee\ compilers accept an extended character set, so that one can
type things like~\.^^Z\ instead of~\.{!=}.  If that's the case in your
system, you should change the relevant part of \.{typedefs.web}, assigning
positions~|01| to~|037| in the most convenient way; for example, at MIT you
can just say $$\hbox{|for (i=1; i<=037; i++) xchr[i]=i;|}$$ since \.{WEB}'s
character set is essentially identical to MIT's, even with respect to
characters less than |040| (see the definitions below).  If, however, the
changes do not conform with these definitions you should change the
definitions as well.  (See \.{typedefs.web} for definitions of |and_and|,
etc.)

@^system dependencies@>
@^notes to myself@>

@<System-dependent parts of character set@>= /* nothing needs to be done */

@* IDENTIFIERS.
At the point during phase one where we're recognizing
identifiers, we sometimes have to determine whether the identifier is a
special one. This is a simple byte-by-byte comparison. However, things are
complicated because by that time the input has been converted to |ASCII|.
Therefore, the comparison tables must also be converted to |ASCII|.

@ Test whether an identifier is a |BUILT_IN|.
@<Func...@>=
boolean is_include_like(VOID)
{
/* Check for \.{m4} built-in. */
if(m4 && is_in(incl_likes,id_first,id_loc)) return YES;

/* The \.{WEB} functions behave as built-ins for \.{WEAVE}, but as macros
for \.{TANGLE}. */  
if(program==tangle) return NO;

if(!(*id_first == @'$' || *id_first == @'_')) return NO; // Speed up |is_in|.
return is_in(WEB_incl_likes,id_first,id_loc);
}

@ Convert lists to |ASCII|.
@<Func...@>=
SRTN conv_bi FCN((b))
	BUILT_IN HUGE *b C1("")@;
{
for( ; b->n != 0; b++) 
	b->name = x__to_ASCII((outer_char *)b->name);
}

SRTN conv_dot FCN((d))
	DOTS HUGE *d C1("")@;
{
for( ;d->code != 0; d++) 
	d->symbol = x__to_ASCII((outer_char *)d->symbol);
}

@ Hunt through a |BUILT_IN| list.
@<Func...@>=

boolean is_in FCN((b0,p0,p1))
	CONST BUILT_IN b0[] C0("Array of built-ins.")@;
	CONST ASCII HUGE *p0 C0("Start of text.")@;
	CONST ASCII HUGE *p1 C1("End of text.")@;
{
CONST BUILT_IN HUGE *b;

for(b=b0; b->n != 0; b++)
	if(web_strcmp(b->name,b->name+b->n,p0,p1) == EQUAL)
			return YES; 

return NO;
}

@
@<Common...@>=

extern DOTS dots0[],mcmds[]; /* These are put into \.{typedefs.web} so we can
				make use of the various \.{@@d}s. */

@ Dot constants are allocated dynamically. Because of \Fortran-90's ability
to define new constants, we have to allow for expanding the size of the
table at run time.
@<Common...@>=

BUF_SIZE delta_dots; /* Expand the table in increments of this size. */
BUF_SIZE ndots; /* The current total size. */
DOTS HUGE *dots,HUGE *dots_end,HUGE *next_dot; /* The dynamic array. */

@ Here we do the initial allocation of the dynamic |dots| table.
@<Allocate dynamic...@>=
{
DOTS HUGE *d;

ALLOC(DOTS,dots,ABBREV(delta_dots),delta_dots,0);
ndots = delta_dots; /* Initialize total size. */
dots_end = dots + ndots;
next_dot = dots; /* Current pointer. */

/* Fill the table with the initial values. */
for(d=dots0; d->len != 0; d++)
	{
	if(dot_code(dots,d->symbol,d->symbol+d->len,d->code) != d->code)    
		CONFUSION("dots allocation","Invalid dot code");
	}
}

@ Either case is allowed for the dot constants. We will convert everything
between the dots in place to upper case.

@<Func...@>=
ASCII HUGE *uppercase FCN((p,n))
	ASCII HUGE *p C0("Start of text.")@;
	int n C1("Number of bytes to convert in place.")@;
{
int k;

for(k=0; k<n; ++k)
	p[k] = A_TO_UPPER(p[k]); /* Convert $n$~bytes in place. */

return p; /* Return beginning address of string. */
}

@ The following routine simply determines whether a decimal point begins a dot
constant; this is used in parsing potential decimal constants.

@<Func...@>=
 
boolean is_dot(VOID)
{
ASCII HUGE *p;
int n;
ASCII temp[MAX_DOT_LENGTH]; /* For converting the putative constant to
				upper case. */

/* Scan to the end of the dot constant (all of which are alphabetic). */
for(p=loc,n=0; n<MAX_DOT_LENGTH; n++,p++)
	if(*p==@'.' || !isAlpha(*p)) break;

if(*p != @'.' || p==loc) return NO; /* It wasn't stopped by a period, or
	the scan didn't even get started, so it
	can't be a dot constant. */
	
STRNCPY(temp,loc,n);
return BOOLEAN(CHOICE(dot_code(dots,uppercase(temp,n),temp+n,dot_const),
	YES,NO));
}

@ Is it in a |DOTS| list? If so, return the associated code. If it is not,
add it to the table. (This was required by \FORTRAN-90.) If necessary,
enlarge the table.

@<Func...@>=

eight_bits dot_code FCN((d0,p0,p1,new_code))
	DOTS HUGE *d0 C0("|DOTS| array.")@;
	CONST ASCII HUGE *p0 C0("Start of text.")@;
	CONST ASCII HUGE *p1 C0("End of text.")@;
	eight_bits new_code C1("May we extend the table or not?")@;
{
DOTS HUGE *d;

re_dot:
  for(d=d0; d < next_dot; d++)
	if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1) == EQUAL)
		{
/* Check for an overloaded operator. If so, remember the details. */
		if(d->code == dot_const)
			{
			STRCPY(dot_op.name+1,d->symbol);
			dot_op.cat = d->cat;
			dot_op.num = (eight_bits)(d-dots);
			}

		return d->code;
		}

/* Didn't find the dot constant or operator in the table. Enlarge the table
if necessary. */
if(!new_code) return NO; /* One can add to |dots|, but not |mcmds|. */

if(next_dot == dots_end)
	{
	if( (dots=(DOTS HUGE *)REALLOC(dots,
		(ndots+delta_dots)*sizeof(DOTS)))==NULL ) 
			OVERFLW("dot operators",ABBREV(delta_dots));
	
	next_dot = dots + ndots; /* Next available position. */
	ndots += delta_dots; /* New total length. */
	dots_end = dots + ndots; /* Upper bound. */
	}

/* Add operator to table. */
next_dot->len = p1 - p0;
next_dot->symbol = GET_MEM("next_dot->symbol",next_dot->len + 1,ASCII);
STRNCPY(next_dot->symbol,p0,next_dot->len);
next_dot->code = new_code; /* Mark as overloaded, or initialize. */
next_dot->cat = 1; /* ??? */
d0 = next_dot++;
next_dot->len = 0;
goto re_dot;
}

@ Is it a macro preprocessor command in a |DOTS| list? 

@<Func...@>=

eight_bits is_mcmd FCN((d0,p0,p1))
	DOTS HUGE *d0 C0("|DOTS| array.")@;
	CONST ASCII HUGE *p0 C0("Start of text.")@;
	CONST ASCII HUGE *p1 C1("End of text.")@;
{
DOTS HUGE *d;

  for(d=d0; d->code; d++)
	if(web_strcmp(d->symbol,d->symbol+d->len,p0,p1) == EQUAL)
		return d->code;

return 0; // Not a preprocessor command.
}


@* INPUT ROUTINES.
The lowest level of input to the \.{WEB} programs is
performed by |input_ln|, which must be told which file to read from.
Unlike the original \WEB s, there is a separate input buffer for each
possible open file, as well as associated parameters for each buffer. These
parameters are collected in an array of structures of type \&{INPUT\_PRMS},
which contains symmetric entries for both input files and change files.
The parameters for the current file are in |*cur0_prms| and are set upon
entry to |input_ln|. This change was necessary in order to accomodate
\Fortran, which, since it reads ahead, leaves stuff in the tail end of the
buffer, to be read on the next call to |input_ln|. If one doesn't have
separate buffers, the change file mechanism won't work properly, nor will
the include facility.

The return value of |input_ln| is |YES| if the read is successful and |NO| if
not (generally this means the file has ended). The conventions
of \TeX\ are followed; i.e., the characters of the next line of the file
are translated to |ASCII| code and copied into the |cur_buffer| array,
and the global variable |limit| is set to the first unoccupied position.
Trailing blanks are ignored. The value of |limit| must be strictly less
than |buf_size|, so that |cur_buffer[buf_size-1]| is never filled.

We assume that none of the |ASCII| values of |*j| for |cur_buffer<=j<limit|
is equal to~0, |0177|, |line_feed|, |form_feed|, or |carriage_return|.
Since |buf_size| is strictly less than |long_buf_size|,
some of \.{WEB}'s routines use the fact that it is safe to refer to
|*(limit+2)| without overstepping the bounds of the array.


@m fp cur0_prms->File /* The current file pointer.  (It's~\.{@@m} instead
	of~\.{@@d} because of a header conflict on the C370 system.) */

@<Common...@>=

BUF_SIZE buf_size; // Holds input line.

ASCII HUGE *loc; // Points to the next character to be read from the buffer.

typedef enum {START,END} DELIM_TYPE;
typedef enum {NO_CMNT,SHORT_CMNT,LONG_CMNT} CMNT_TYPE;

typedef struct
	{
	CMNT_TYPE type;
	DELIM_TYPE delim;
	eight_bits len; // Length of the delimiter; either~$0$, $1$, or~$2$.
	ASCII HUGE *pos; // Start of the delimiter.
	} CMNT_DATA;

CMNT_DATA posns[50],HUGE *pcmnt = posns;

@*1 Reading an input line.
In the unlikely event that your standard I/O
library does not support |feof|, |getc| and |ungetc| you may have to change
things here.  
@^system dependencies@>

This function copies a line into |cur_buffer| or returns |NO| if it's
gotten to the end-of-file.

@d input_line_length 160

@<Func...@>=

boolean input_ln FCN((p0))
   INPUT_PRMS0 HUGE *p0 C1("Which structure describes the current file?")@;
{
cur0_prms = p0;	// Address of current parameters.
limit = cur_buffer;	/* Initialize the top to the bottom. |limit| points to
				first unfilled position. */

cur_line++; /* A separate line count is kept for each file (including the
		change file). */

/* |column_mode| and |parsing_mode| may be redundant. But don't mess with
these. */
if(!nuweb_mode && FORTRAN_LIKE(language) && column_mode && parsing_mode==OUTER)
	switch(language)
		{
	   case FORTRAN:
	   case FORTRAN_90:
		if(!rd_Fortran())
			return NO;
		break;

	   case RATFOR:
	   case RATFOR_90:
		if(!rd_Ratfor())
			return NO;

		if(limit==cur_buffer) 
			goto empty_line;
		break;

	   default:
		CONFUSION("input_ln","Invalid FORTRAN_LIKE language");
		}
else 
	if(!rd_free_form())
		return NO;

/* Take care of an empty line: kill the semicolon. (This is a bit shaky.) */
if(column_mode && FORTRAN_LIKE(language) && 
	PTR_DIFF(size_t,limit,cur_buffer)==2 &&	
	((!auto_semi && (cur_buffer[1]==@';' || cur_buffer[1]==@' ')) ||
	(auto_semi && cur_buffer[1]==@';' && (cur_buffer[0]=='C' ||
		cur_buffer[0]==@'c' || cur_buffer[0]==@'*'))))
  empty_line:
	limit = cur_buffer;
	
@#if 0
fin_line:
	;
@#endif /* For future use. */

#if(DEBUG)
	@<Echo the line to be returned from |input_ln|@>;
#endif

return YES;	/* Successful read */
}

@ For debugging purposes, echo the line which will be returned. For the
benefit of the user, replace the |begin_comment0| by~'\.{!}' and
|begin_comment1| by~'\.?'. Turn on this echo with the command-line
option~'\.{-l}'. A positive numeric argument means only start debugging at
that line number; a negative one means also print the address of the
buffer.

@<Other...@>=
long start_line = 1; // Must be |long|; a negative value is used as a flag.
long end_line = LONG_MAX;

@
@<Echo the line...@>=
{
register ASCII HUGE *k;

if(prn_input_lines && cur_line >= (LINE_NUMBER)start_line
		&& cur_line < (LINE_NUMBER)end_line) 
	{
	if(prn_input_addresses)
		printf("%lu->%lu (%u) ",
			(unsigned long)cur_buffer,(unsigned long)limit,
			limit-cur_buffer); 

	printf("%c[%d%s:%u]: \"",
		(language == global_language ? ' ' : *LANGUAGE_CODE(language)),
		incl_depth,
		(changing ? "*" :""),
		cur_line); 

	for(k=cur_buffer; k<limit; ++k)
		switch(*k)
			{
		   case (ASCII)begin_comment0:
			printf("</*>");
			break;

		   case (ASCII)begin_comment1:
			printf("<//>");
			break;

		   case interior_semi:
			printf("<;>");
			break;

		   default:
			putchar(XCHR(*k));
			break;
			}

	puts("\"");
	}
}

@*1 Free-form input.
The simplest, most straightforward thing to do is read
completely free-form syntax. This is done for~C and for \RATFOR-77. Here is
one of the clearest examples of when to prefix single-quoted characters
with~'\.{@@}'.

@a
boolean rd_free_form(VOID)
{
register int c='\0'; // The character read.
register ASCII HUGE *k;  // Where next character goes.

@<Read free-form syntax@>@;

return YES;
}

@
@<Read free...@>=
{	
if(num_in_buffer != 0) 
	@<Flush \Fortran\ buffer.@>@;
else
	{
	if (feof(fp)) 
		return NO;  // We have hit end-of-file.

	@<Read by bytes@>;
@#if(0)
	@<Read by records@>;
@#endif /* For speeding up input; not debugged. */
	}
}

@ This is the original byte-oriented input routine. It is ANSI-compatible.
However, on some systems such as VAX/VMS, it may be slow.

@d TOO_LONG err_print(C,"Input line too long; \
use the `-ybs...' option to increase buffer size from its present value of \
%lu characters",buf_size)

@<Read by bytes@>=
{
k = cur_buffer;  /* beginning of buffer */

@#if 0
if(column_mode && language==TEX)
	{ // Make each line a short comment.
	*k++ = @'/'; @+ *k++ = @'/';
	}
@#endif

while (k<=buffer_end && (c=getc(fp)) != EOF && c!='\n')
     	if ((*(k++) = XORD(c)) != @' ') limit = k; /* Update first unfilled
position; |k|~is now pointing to next position to fill, and the last one
wasn't blank. */

if (k>buffer_end)
    if ((c=getc(fp))!=EOF && c!='\n') 
	{
      ungetc(c,fp); loc=cur_buffer; TOO_LONG;
@.Input line too long@>
	}

if (c==EOF && limit==cur_buffer) 
	return NO;  // There was nothing after the last newline.
}

@ This is an experimental block to speed up the input. It is not complete.
For VAX/VMS, it works only for files with variable length record formats,
not with stream files.
@<Read by records@>=
@{
int n;

@b
for(k = cur_buffer; k < buffer_end &&
	(n = fread(k,buffer_end-k,fp))!=0 &&
	k[n-1]!='\n'; k += n); 

k += n;

if(k==buffer_end && *(k-1) != '\n')
	{
	loc = cur_buffer;
	TOO_LONG;
	}

#if(TRANSLATE_ASCII)
	TERMINATE(cur_buffer,n);
	to_ASCII(cur_buffer);
#endif


while(*(k-1)==@'\n' && k > cur_buffer) k--;
while(*(k-1)==@' ' && k > cur_buffer) k--;

limit = k;

if(n==0 && limit==cur_buffer) return NO;
}

@*1 \Fortran\ input.
It's probably hopeless to explain the present version
of the \FORTRAN\ input driver. It should be abandoned and rewritten from
scratch. The best that can be said about \FORTRAN\ with \FWEB\ is that one
should use \RATFOR\ instead.

The problem with \FORTRAN's fixed column format is that we must read ahead to 
get any continuation lines which may be waiting. By the time we've figured
that out, we've read too far. We leave that stuff waiting, signified by
|num_in_buffer != 0|. On the next time into |input_ln|, the waiting stuff
will first be moved to the beginning of the buffer; then we go on and read
ahead some more.

In the following, |limit|~is the next available space in the buffer, |k|~is
the present position; |k0|~marks the beginning of the last line read. Each
line is actually 5~bytes longer than the actual number of characters read:
2~bytes for a possible |"*/"|, 3~for use by the scanning routines of
\TANGLE, which may put things there during its scans.

@d N_WORK 3
@d N_END (N_WORK+2)

@a
boolean rd_Fortran(VOID)
{
register int c='\0'; // The character read.
register ASCII HUGE *k;  // Where next character goes.
boolean first_line = YES;

/* We're starting afresh; initialize flags. */
last_was_continued = NO;
scanning_C_cmnt = NO;

/* Keep reading lines until we sense a non-comment, non-continuation line.
Leave the latter waiting in the buffer starting at~|k0|. */
for(k= limit; ; k=k0 = (limit+=N_END),first_line=NO,cur_line++)
	if(num_in_buffer == 0) 
		@<Append to buffer.@>@;
	else 
		@<Fill buffer from previous read.@>@;

/* Except for new module, throw away all stuff after \.{@@}~command in
column~1. */
if(*cur_buffer==@'@@' && !(limit==cur_buffer+1 || *(cur_buffer+1)==@'*' ||
		*(cur_buffer+1)==@' ')) 
	for(k=cur_buffer+2; k<limit; ++k)
		if(*k == @';')
			{
@#if(0)
			limit = k;
@#endif
			*k = @' ';
			break;
			}

return YES;
}

@ If |num_in_buffer == 0| on entry to |input_ln|, there's the beginning of
a line already waiting. That line starts at~|k0|. Here, we move it to the
beginning of the buffer.

@<Fill buffer from previous...@>=
{
@<Flush \Fortran\ buffer.@>;

/* If what was waiting was a control line, we must shift out of column mode. */
if(found_at)
	{
    out_of_column_mode:
	found_at = column_mode = last_was_empty = NO;
	break; /* Break out of |for| loop which reads lines. The finish-read
			material is moot. */
	}

if(at_line) 
	{
	last_was_empty = NO;
	break;
	}

/* Finally, we give special treatment to empty lines. */
last_was_empty = BOOLEAN(limit==cur_buffer);
scan_for_cmnts();
} /* Go back to the |for| loop which reads lines. */

@ Here we move stuff waiting in the buffer to the beginning of the buffer,
and reset the end of the buffer.

@<Flush \Fortran\ buffer.@>=
{
STRNCPY(cur_buffer,k0,num_in_buffer); // Move line to beginning of buffer.
k0 = cur_buffer; // For |scan_for_cmnts|
limit = cur_buffer + num_in_buffer - N_END; // Reposition the end of buffer.
num_in_buffer = 0; // We've now cleaned out the buffer.
}

@ We get to here when |num_in_buffer == 0|. 
@<Append to buffer.@>=
@{
int i;

@b
if (feof(fp)) 
	{
	if(first_line) return NO;  // We have hit end-of-file.
	else goto concatenate_cmnts; //	Don't lose the last line.
	}

k0 = limit; // Set the start of this line to the end of the old one.

@<Read \Fortran\ line.@>; // |limit| is positioned after the last char.\ read.

/* We will allow two extra characters at the end, in case we need to put
end-of-comment markers there; we also need two bytes for Tangle's workspace. */
MEMSET(limit,@' ',N_END);
num_in_buffer = 0; // There's nothing waiting.

/* If we've read into a |new_module| command in column~1, 
	prepare to switch out of column mode. */
at_line = BOOLEAN(*k0==@'@@' && *(k0+1) != @'/');

if(at_line && (*(k0+1)==@'*' || *(k0+1)==@' ')) found_at = YES;

/* If we were appending, then we must delay shifting out of column mode until
we process the first part of the buffer. However, if we're actually at the
beginning of the buffer, then we must shift out of column mode immediately. */
if(found_at && k0==cur_buffer) goto out_of_column_mode;

if(first_line && at_line) break;

/* Now we look at the line we just put into the buffer. Usually, we should
look at that to see whether it's a continuation or a comment line, because if
so we keep on reading. However, if it's a command line, or if we're in the
middle of handling a trailing C~comment which didn't end on the previous
line, then this line should not be treated in column mode. */
if(scanning_C_cmnt)
	{
	scan_for_cmnts();
	continue;
	}

if(!(at_line || scanning_C_cmnt)) 
	@<Check for comment or continuation.@>@; 

/* If we get to here, it's neither a comment nor a continuation. If this line
was the first in the buffer, we must continue to read more.  (However,
if this line is null, then we do not read any more, because we don't want to
concatenate a null comment to the previous line.) Otherwise, we're
done reading and we should leave this line waiting in the buffer. */
neither_cmnt_nor_continuation:
if(first_line)
	if(limit==cur_buffer) /* Quit on null first line. */
		{
		comment_in_buffer = NO;
		num_in_buffer = 0;
		break;
		}
	else
		{
		scan_for_cmnts();
		continue;  /* We must read some	more to see if next is
continuation. */ 
		}

@<Finish reading lines.@>;
}

@ This is the end of this read. Replace the newline by a semicolon to
delimit the statements.

@<Finish read...@>=
{
last_of_read:
 if(!first_line)
  {
  num_in_buffer = PTR_DIFF(size_t,limit,k0) + N_END;
  limit = MAX(k0 - N_WORK,cur_buffer);
  }
else limit += N_WORK;

concatenate_cmnts:
anlz_cmnts(); // Concatenate comments appropriately, and set |scanning_C_cmnt|.

cur_line--;
break; /* Break out of |for| loop. */
}

@ Read characters for one line into buffer, translating them as we go.
Trailing blanks will be ignored. Tabs will be translated into 6~spaces.

@d is_point(c) (point_comments && c=='!')

@<Read \Fortran\ line.@>=
while(k<=buffer_end && (c=getc(fp)) != EOF && c!='\n' && 
		( k-k0 < input_line_length) ) 
	if(c=='\t' && k<=buffer_end-6) 
		for(i=0; i<6; ++i) *(k++) = @' ';/* Translate tab
character. (Don't update |limit|.) */
	else
		{
		boolean escaped_char = NO;

		if(c==';') c = XCHR(interior_semi);
		else if(point_comments && (*k0 != @'@@') && 
				(escaped_char = BOOLEAN(c == '\\')))
			{
			c = getc(fp); // What's coming up next?
			
/* If it's not an escaped point, just copy the escape sequence. */
			if(c != '!') 
				{
				ungetc(c,fp);
				c = '\\';
				}
			}

/* A point that's not escaped begins a short comment. */
		if( (*(k++) = CHOICE(is_point(c) && !escaped_char,
				(ASCII)begin_comment1,XORD(c))) != @' ') 
			limit = k; // Ignore trailing blanks.
		}

/* If we were cut short by the column~72 restriction, skip to end. */
if(c!=EOF && c!='\n')
	while(k<=buffer_end && (c=getc(fp)) != EOF && c!='\n') ; 

if (k>buffer_end)
    if ((c=getc(fp))!=EOF && c!='\n')
	{
      ungetc(c,fp); loc=cur_buffer; TOO_LONG;
@.Input line too long@>
	}

if (c==EOF && limit==cur_buffer) return NO;  /* there was nothing after
    the last newline */


@ Here we examine the line most recently read to see if it's a comment or
continuation. If that's true, then we continue to the bottom of the
enclosing |for| loop which reads lines.

@<Check for comment or cont...@>=
@{
boolean is_cmnt = NO, Fortran_cmnt = NO, C_cmnt = NO;

ASCII HUGE *p = k0; /* Points to the comment character. */

@b
/* Did we get a comment line?  */
switch(*k0)
	{
	case @'C':
	case @'c':
	case @'*':
	case (ASCII)begin_comment0:
	case (ASCII)begin_comment1:
		is_cmnt = Fortran_cmnt = YES;
		break;

	default:
/* Skip over white space at beginning of line. */
		for(; p<limit; p++) if(*p!=@' ') break;

		if( (*p==@'/' && (*(p+1)==@'*' 
				|| (*(p+1)==@'/' && Cpp_comments)))
			|| *p == (ASCII)begin_comment0
			|| *p == (ASCII)begin_comment1) is_cmnt = C_cmnt = YES;
		break;
	}

if(is_cmnt) @<Process comment line.@>@;

/* If we're this far, it's not a comment. Check for continuation line
(neither blank nor |'0'| in column~6). If
so, shift it over to abut it with previous stuff in buffer. */
if(limit-k0 >=5 && !(k0[5] == @' ' || k0[5]==@'0') )
	@<Process possible continuation line.@>@;
}


@ The line is a comment line. We give special treatment to an otherwise null
comment line, treating it as a line with nothing in it at all. If the last
line was a comment also, we concatenate this one with the previous one. 

@<Process comment line.@>=
{
if(limit == k0+1) 
	{ /* Null comment line. */
	limit = k0;
	if(!first_line) goto last_of_read;
	else goto concatenate_cmnts;
	}

if(k0 > cur_buffer) MEMSET(k0-N_END,@' ',N_END);

if(Fortran_cmnt) *p = begin_comment1;

/* If the last line was empty, we don't want to read any further; leave this
comment waiting in the buffer. */
if(last_was_empty)
	{
	num_in_buffer = PTR_DIFF(size_t,limit,k0) + N_END;
	comment_in_buffer = YES;
	limit = cur_buffer;
	 break; /* Break out of the |for| loop which reads lines. */
	}

scan_for_cmnts();
continue; /* Go back and read more lines. */
}


@ The line is a possible continuation line; namely, it has something in
column~6. However, if we're in the midst of a trailing C~comment or if an
alphanumeric label extends into column~6, then it's not a continuation. We
check for these possibilities by seeing whether there's anything in columns
1--5. 

@<Process possible continuation...@>=
@{
register ASCII HUGE *l;
boolean stuff_in_1_5;

@b
if(first_line) 
	{/* Error: Continuation line not expected. */
	scan_for_cmnts();
	continue; 
	}

/* We don't allow anything in columns 1--5 for a continuation line. That's
a FORTRAN rule, and it helps us to catch a possible continuation of a
C-style comment. */
stuff_in_1_5 = NO;

for(l=k0;l<k0+5; ++l)
	if(*l != @' ')
		{
		stuff_in_1_5 = YES;
		break;
		}

 /*  If there's stuff in columns 1--5, it's not a continuation line.
Otherwise, it's a continuation line; abut it with the code in the previous
line. */
if(stuff_in_1_5) goto neither_cmnt_nor_continuation;

*l = @' '; // Delete the continuation symbol.
scan_for_cmnts();
continue; /* Keep on reading. */
}

@ The following function records the status and position of a comment
delimiter. 
@a
SRTN mark_cmnt FCN((type0,delim0,length0,pos0))
	CMNT_TYPE type0 C0("")@;
	DELIM_TYPE delim0 C0("")@;
	eight_bits length0 C0("")@;
	ASCII HUGE *pos0 C1("")@;
{
pcmnt->type = type0;
pcmnt->delim = delim0;
pcmnt->len = length0;
pcmnt->pos = pos0;

if(type0 == LONG_CMNT) scanning_C_cmnt = BOOLEAN(delim0 == START);

pcmnt++;
pcmnt->type = NO_CMNT;
pcmnt->delim = START;
pcmnt->len = 0;
pcmnt->pos = limit;
}

@

@d MARK(type,delim,len) mark_cmnt(type,delim,len,p)

@a
SRTN scan_for_cmnts(VOID)
{
register ASCII HUGE *p;

for(p=k0; p<limit; p++)
	switch(*p)
		{
	   case (ASCII)begin_comment0:
		if(scanning_C_cmnt) break;

		MARK(LONG_CMNT,START,1);
		break;

	   case (ASCII)begin_comment1:
		if(scanning_C_cmnt) break;

		MARK(SHORT_CMNT,START,1);
		p = limit;
		MARK(SHORT_CMNT,END,0);
		break;

	   case @'/':
		if(scanning_C_cmnt) break;

		if(*(p+1) == @'/' && Cpp_comments)
			{
			MARK(SHORT_CMNT,START,2);
			p = limit;
			MARK(SHORT_CMNT,END,0);
			}
		else if(*(p+1) == @'*')
			{
			MARK(LONG_CMNT,START,2);
			p++;
			}

		break;

	   case @'*':
		if(scanning_C_cmnt && *(p+1) == @'/')
			{
			MARK(LONG_CMNT,END,2);
			p++;
			}

		break;
		}
}
		
@
@d BLANK_OUT(d) MEMSET((d)->pos,@' ',(d)->len)
@a
SRTN anlz_cmnts(VOID)
{
CMNT_DATA *d;
boolean found_text = NO;
ASCII HUGE *l;

pcmnt->pos = limit;

for(d=posns + 1; d<pcmnt; d+=2)
	{
	found_text = NO;

	for(l=d->pos+d->len; l<(d+1)->pos; l++)
		if(*l != @' ')
			{
			found_text = YES;
			break;
			}

	if(found_text)
		{
		if(d->type == SHORT_CMNT) 
			{
			BLANK_OUT(d-1);
			*((d-1)->pos) = begin_comment0;
			*(d->pos) = @'*';
			*(d->pos + 1) = @'/';
			}
		}
	else if(d->type == (d+1)->type)
		{
		BLANK_OUT(d);
		BLANK_OUT(d+1);
		d->type = (d+1)->type = NO_CMNT;
		}
	}

@<Insert an automatic semicolon@>@;

pcmnt = posns; // Reset.
}

@ 
@<Scan backwards over comments@>=
for(pk = k0-1; ;)
	if(!bscn_white() || !bscn_cmnt()) break;

@
@<Common...@>=

ASCII HUGE *pk;

@ 
@<Unused@>=

boolean bscn_white(VOID)
{
for( ; pk>=cur_buffer; --pk)
	if(*pk != @' ') return YES;

return NO;
}

boolean bscn_cmnt(VOID)
{
/* Are we at end of comment? */
if( !(*pk==@'/' && *(pk-1) == @'*') ) 
	{
	++pk; /* Copy the continuation line to here. */
	return NO; /* Not on white space and
not on end of comment; we're done. */
	}

/* Scan backwards to beginning of comment. Must allow for both kinds
of comment styles. */
for(pk -=N_END; pk >= cur_buffer; --pk)
	if(*pk==(ASCII)begin_comment0 || 
		*pk==(ASCII)begin_comment1 ||
		(*pk==@'/' && (*(pk+1) == @'*' || *(pk+1)==@'/')))
					/* Found start of comment. */ 
			{
			--pk;
			return YES;
			}

return NO;
}

@ In Fortran mode, the last thing we do before returning the line is to
parse looking for comments. We want to propagate the final semicolon to
just before the last comment.  With this scheme, the innards of \WEAVE\ and
\TANGLE\ are presented with a uniform syntax.  

@<Common...@>=

static ASCII HUGE *lp,HUGE *semi_pos;
static boolean found_text,text,C_style_cmnt,short_cmnt,R_style_cmnt;

@ 
@<Insert an auto...@>=
{
boolean text_after = NO;

if(pcmnt > posns)
	{ // There's at least one comment.
	if(!scanning_C_cmnt)
	   for(l=limit-1; l>(pcmnt-1)->pos + (pcmnt-1)->len; l--)
		if(*l != @' ')
			{ // There's text after the comment.
			text_after = YES;
			*(l+1) = @';';
			break;
			}

	if(!text_after)
	   {
	   pcmnt -= 2;

	   if(pcmnt < posns)
		{
		ERR_PRINT(C, "Fortran comment didn't end; missing */?");
		pcmnt = posns;
		}

	   while(pcmnt->type == NO_CMNT) 
		{
		pcmnt--;

		if(pcmnt < posns)
			CONFUSION("Insert an automatic semicolon", 
"Invalid comment structure");
		}

	   for(l=pcmnt->pos - 1; l>=cur_buffer; l--)
		{
		if(*l != @' ')
			{ // There's text before the comment.
			semi_pos = pcmnt->pos;
			@<Fill in semi@>@;
			break;
			}
		}
	   }
	}
else 
	{ // No comments at all.
	for(l=limit-1; l>=cur_buffer; l--)
		if(*l != @' ')
			{
			*(l+1) = @';';
			break;
			}
	}
}

@ Here we put in the semicolon. We have to watch out for a preceding
`\.{@@}' sign, which signifies a verbatim comment.
@<Fill in semi@>=
{
*(semi_pos+1) = ((pcmnt+1)->type==LONG_CMNT ? begin_comment0 :
			begin_comment1); /* If the comment was started by 
	|begin_comment0| or |begin_comment1|, this overwrites the character
	after that. (We 
	have to make room for the semicolon.) If we want to cure this, we
	must do more copying. */

if(semi_pos > cur_buffer && *(semi_pos-1) == @'@@') /* A verbatim comment. */
	{
	*(semi_pos--) = @'@@';
	}

*semi_pos = @';'; /* This overwrites the beginning of the comment marker,
	or the previous~\.{@@} if there was one. */

@<Interchange line-break and semi@>;
}

@ As a kludge, if the Fortran line ends with an \.{@@/}, we interchange it
with the semicolon.
@<Interchange line-break...@>=

for(lp=semi_pos-1; lp>cur_buffer; lp--)
	{
	if(*lp == @' ') continue;

	if(*lp == @'/' && *(--lp) == @'@@')
		{
		*semi_pos = @' ';
		*lp = @';'; @+ *(lp+1) = @'@@'; @+ *(lp+2) = @'/';
		}
	break;
	}


@*1 \Ratfor\ input.
@a
boolean rd_Ratfor(VOID)
{
register int c='\0'; // The character read.
register ASCII HUGE *k;  // Where next character goes.
boolean found_semi;

@<Read free...@>@;

/* If we've read into a |new_module| command in column~1, 
	switch out of column mode. */
if(*cur_buffer == @'@@' && (limit==cur_buffer+1
		|| *(cur_buffer+1)==@'*' || *(cur_buffer+1)==@' ')) 
	column_mode = NO;
else 
	@<Finish Ratfor line.@>;

return YES;
}

@
@<Common...@>=

static ASCII HUGE *last_pos;
static ASCII cmnt_char;

@ This section has to handle the completely free-form syntax as well as the
``obviously continued'' syntax. The latter is more trouble than it's worth,
and isn't recommended.
@<Finish Ratfor line.@>=
{
last_was_continued = continuing_line;
continuing_line = NO;

if(limit==cur_buffer) 
	return YES;

limit[0] = limit[1] = limit[2] = limit[3] = @' ';

cmnt_char = @'#';

found_semi = found_text = text = NO; /* Start off assuming we're in comment
mode. */ 
semi_pos = NULL; /* |semi_pos| will record the position of a prospective
comment, to be begun by a semicolon. */

/* Scan the line. */
if(!free_form_input && !(*cur_buffer==@'@@' && *(cur_buffer+1)==@'#'))
   {
   for(lp=cur_buffer; ;)
	if(!skip_Rtext() || !skp_cmnt()) break;

    switch(*last_pos)
		{
		case @'+': case @'-': case @'*': case @'=':case @'{':case @'}':
		case @'^': case @'&': case @'|': case @'(': case @':':
		case @'>': case @'<': case @'[': case @',': case @'\\':
			continuing_line = YES;
			break; /* Line is continued. */

/* Ratfor's continuation character. */
		case @'_': 
				if(last_pos > cur_buffer)
					{
					ASCII c;
				
					c = *(last_pos-1);
					if(isAlpha(c) || isDigit(c) ||
						c==@'_' || c==@'$') 
							goto not_continuation;
					}
				*last_pos = @' '; 
				continuing_line = YES;
				break;

		default:
		   not_continuation:
			if(!auto_semi) break;

/* If the last construction is a comment (|!text|) and there was actually
some text (|semi_pos!=NULL|),
replace ``\.{\slashstar}'' by |';'| and |begin_comment0| or
|begin_comment1|. */ 
		   if(!text && semi_pos!=NULL) @<Fill in semi@>@;
		   else if(found_text && limit > cur_buffer) *limit++ = @';';
					/* Line ended. */ 
			break;
		}
   }
}

@ This nucleus skips over text in a line, stopping if it finds a comment. 

@d is_C_style_cmnt (C_style_cmnt = ((short_cmnt = Cpp_comments && *lp ==
@'/' && *(lp+1) == @'/')) || (*lp == @'/' && *(lp+1) == @'*') )

@d start_comment (is_C_style_cmnt || (*lp == (char)begin_comment0)
	|| (*lp == (char)begin_comment1) ) 

@<Unused@>=

boolean skip_Ftext(VOID)
{
@<Begin skipping text@>;

/* If we haven't found a comment, set mode to text. */
if(!start_comment)
	{
	found_text = text = YES;
	++lp;
	}

/* Scan to a comment. */
for(; lp<limit; ++lp)
	if(start_comment)
		if(++lp < limit) return YES;

return NO;
}

@ This nucleus skips over text in a line, stopping if it finds a comment. 

@d start_Rcomment ( (R_style_cmnt=BOOLEAN(*lp==cmnt_char && 
		*(lp+1)!=cmnt_char && *(lp-1)!=cmnt_char &&
		!(*(lp-1)==@'@@'))) || is_C_style_cmnt)

@a
boolean skip_Rtext(VOID)
{
static ASCII blank = @' ';

@<Begin skipping text@>;

last_pos = &blank;

/* If we haven't found a comment, set mode to text. */
if(!start_Rcomment)
	{
	found_text = text = YES;
	}

/* Scan to a comment. */
for(; lp<limit; lp++)
	{
	if(start_Rcomment)
		{
		if(R_style_cmnt)
			{
			*lp = cmnt_char = begin_comment0;
			*limit++ = @'*'; @+ *limit++ = @'/';
			}
		if(++lp < limit) return YES;
		}

	if(*lp != @' ' && *lp != tab_mark)
		last_pos = lp; /* Remember last non-blank position. */
	}

return NO;
}

@
@<Begin skipping ...@>=

if(scanning_C_cmnt) return YES; /* Make sure |skp_cmnt| is the first to be
					executed. */

/* Start scanning at the current position. Skip over white space. */
for(; lp<limit; ++lp)
	if(!(*lp==@' ' || *lp==tab_mark)) break;

if(lp >= limit) return NO; /* The line was all white space. */

@ This nucleus skips over comments. */
@a
boolean skp_cmnt(VOID)
{
/* If the last mode was text, remember the position for a possible semi. */
if(text) semi_pos = lp - 1;

text = NO;	/* We're in comment mode. */
scanning_C_cmnt = NO; /* Flag used to handle the next line properly if the
				comment runs over. */

/* Scan to end of comment. */
if(C_style_cmnt)
	{
	if(short_cmnt)
		{
		lp = limit;
		return YES;
		}

	for(++lp; lp<limit; lp++)
		{
		if(*lp==(ASCII)begin_comment0 || *lp==(ASCII)begin_comment1)
			{
			*lp = @'c';
			continue;
			}

		if(*lp==@'*' && *(lp+1)==@'/')
			{
			lp += 2; /* Position after end of comment. */
			if(lp<=limit) return YES;
			}
		}

	scanning_C_cmnt = YES;
	}
else
	{
	for(++lp; lp<limit; lp++)
		if(*lp==(ASCII)begin_comment1)
			 *lp = @'!';

	*(limit-2) = @'*'; @+ *(limit-1) = @'/';
	}

return NO;
}
		
@*1 Change files.
Now comes the problem of deciding which file to read from
next.  Recall that the actual text that \.{WEB} should process comes from
two streams: a |web_file|, which can contain possibly nested include
commands~`\.{@@i}', and a |change_file|, which should not contain includes.
The currently open files form a stack |prms|.  Each entry has two
components: |web| and |change|.  Thus, for any open web or include file,
there can be a separate change file is desired.  If no change file is
specified at any include level, the change file from the last level is used
instead.  Thus, one could have just one change file that changes entries in
both the |web_file| and all of the files included into the |web_file|.  The
boolean |changing| tells whether or not we're reading form the
|change_file|.

The line number of each open file is also kept for error reporting and
for the benefit of \.{TANGLE}, as are various other parameters.

|cur0_prms| points to the parameter component, either |web| or |change|,
being or just processed by |input_ln|. 

|cur_prms| points to the current stack level, including both |web| and
|change| components.

@d k0 cur0_prms->K0
@d found_at cur0_prms->Found_at
@d at_line cur0_prms->At_line

@ When |changing=NO|, the next line of |change_file| is kept in
|change_buffer|, for purposes of comparison with the next
line of |cur_file|. After the change file has been completely input, we
set |change_limit=change_buffer|, so that no further matches will be made.

Here's a shorthand expression for inequality between the two lines:

@d LINES_DONT_MATCH (change_limit-change_buffer != limit-cur_buffer ||
  STRNCMP(cur_buffer, change_buffer, PTR_DIFF(size_t,limit,cur_buffer)))

@d change_params prms[incl_depth].input_params

@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
for the next matching operation. Since blank lines in the change file are
not used for matching, we have |(change_limit==NULL && !changing)| if and
only if the change file is exhausted. This procedure is called only
when |changing| is |YES|; hence error messages will be reported correctly.

@<Func...@>=
SRTN prime_the_change_buffer(VOID)
{
INPUT_PARAMS input_params; // Saves incoming state.

input_params.Language = language;
input_params.Parsing_mode = parsing_mode;
input_params.Column_mode = column_mode;

language = change_params.Language;
parsing_mode = change_params.Parsing_mode;
column_mode = change_params.Column_mode;

change_limit = NULL; // This value will be used if the change file ends.

  @<Skip over comment lines in the change file; |goto done_priming| if end
of file@>; 
  @<Skip to the next nonblank line; |goto done_priming| if end of file@>;

done_priming:
	language = input_params.Language;
	parsing_mode = input_params.Parsing_mode;
	column_mode = input_params.Column_mode;

/* After we're done priming the change buffer, we will next read from the
input file. */
changing = NO;
cur0_prms = cur_prms.web;
}

@ While looking for a line that begins with~\.{@@x} in the change file,
we allow lines that begin with~\.{@@}, as long as they don't begin
with~\.{@@y} or~\.{@@z} (which would probably indicate that the change file is 
fouled up).

@<Skip over comment lines in the change file...@>=

WHILE() 
	{
	ASCII c;

	if (!input_ln(CHANGE_FILE)) 
		{
		change_limit = NULL;
		goto done_priming;
		}

	if (limit < cur_buffer+2) continue; 
		// There can't be an \.{@@}~command.
	if (cur_buffer[0] != @'@@') continue; 
		// Skip lines that don't start with~\.{@@}.
	@<Lowercasify |cur_buffer[1]|@>;
	@<Check for erroneous \.{@@i}@>;
	if ((c=cur_buffer[1])==@'x') break; // Found beginning of a change.

	if (c==@'y' || c==@'z') 
		{
		loc = cur_buffer+2; // Skip erroneous change.
		ERR_PRINT(C,"Where is the matching @@x?");
@.Where is the match...@>
		}
	else @<Process language-related change command@>@;
	}

@
@<Process language-related change...@>=
{
if(c==@'l') 
	if(limit == cur_buffer+2) 
		ERR_PRINT(C,"Missing language character after @@L");
	else c = cur_buffer[2];

switch(c)
	{
   @<|ASCII| cases for |C|@>:
	language = change_params.Language = 
		(cur_buffer[2] == @'+') ? C_PLUS_PLUS : C; 
	column_mode = change_params.Column_mode = NO;
	continue;

   @<|ASCII| cases for |RATFOR|@>:
	if(!RAT_OK("Language change ignored")) continue;

	language = change_params.Language = 
		(cur_buffer[2] == @'9') ? RATFOR_90 : RATFOR; 
	continue;
		
   @<|ASCII| cases for |FORTRAN|@>:
	language = change_params.Language = 
		(cur_buffer[2] == @'9') ? FORTRAN_90 : FORTRAN; 
	continue;

   @<|ASCII| cases for |LITERAL|@>:
	language = change_params.Language = LITERAL; continue;

   @<|ASCII| cases for |TEX|@>:
	language = change_params.Language = TEX; continue;

   case @'[': 
	column_mode = change_params.Column_mode = YES;continue;

   case @']':
	column_mode = change_params.Column_mode = NO;continue;

   default:
	loc = cur_buffer + 2;
	ERR_PRINT(C,"Invalid @@ command in change file");
	continue;
	}
}

@ This line of code makes~|"@@X"| equivalent to~|"@@x"| and so on.

@<Lowerc...@>=

if ((cur_buffer[1]>=@'X' && cur_buffer[1]<=@'Z') || cur_buffer[1]==@'I') 
	cur_buffer[1]+=@'z'-@'Z';

@ We do not allow includes in a change file, so as to avoid confusion.

@<Check for erron...@>=

if (cur_buffer[1]==@'i') 
	{
	loc = cur_buffer + 2;
	ERR_PRINT(C,"Sorry, no includes allowed in change file");
@.No includes allowed...@>
	}

@ Here we are looking at lines following the~\.{@@x}.

@<Skip to the next nonblank line...@>=

do 
	{
	if (!input_ln(CHANGE_FILE)) 
		{
		ERR_PRINT(C,"Change file ended after @@x");
@.Change file ended...@>
		change_limit = NULL;
		goto done_priming;
		}
	} 
while (limit==cur_buffer);

@ The following procedure is used to see if the next change entry should go
into effect; it is called only when |changing| is~|NO|.  The idea is to
test whether or not the current contents of |cur_buffer| matches the
current contents of |change_buffer|.  If not, there's nothing more to do;
but if so, a change is called for: All of the text down to the~\.{@@y} is
supposed to match. An error message is issued if any discrepancy is found.
Then the procedure prepares to read the next line from |change_file|.

@<Func...@>=
SRTN chk_change(VOID) // Switches to |change_file| if the buffers match.
{
int n = 0; // The number of discrepancies found.

if(LINES_DONT_MATCH) return;  // Didn't match a change.

WHILE() 
	{
	changing = YES; prn_where = YES; 

	if (!input_ln(CHANGE_FILE)) 
		{
		ERR_PRINT(C,"Change file ended before @@y");
@.Change file ended...@>
		change_limit = NULL; changing = NO; prn_where = YES;
		return;
		}

	@<If the current line starts with \.{@@y},
	      report any discrepancies and |return|@>;@/
	changing = NO; prn_where = YES; 

	while(!input_ln(INPUT_FILE)) 
		{ /* Pop the stack or quit. */
		if (incl_depth==WEB_FILE) 
			{
		        ERR_PRINT(C,"WEB file ended during a change");
@.WEB file ended...@>
		        input_has_ended = YES; return;
		        }

		incl_depth--; prn_where = YES; 
		}

	if(LINES_DONT_MATCH) n++;
	}
}

@ 
@<If the current line starts with \.{@@y}...@>=

if (limit>cur_buffer+1 && cur_buffer[0]==@'@@') 
	{
	@<Lowerc...@>;
	@<Check for erron...@>;

	if (cur_buffer[1]==@'x' || cur_buffer[1]==@'z') 
		{
		loc=cur_buffer+2; 
		ERR_PRINT(C,"Where is the matching @@y?");
@.Where is the match...@>
		}
	else if (cur_buffer[1]==@'y') 
		{
		if (n>0) 
			{
			loc = cur_buffer + 2;
	ERR_PRINT(C,"Hmm... some of the preceding lines failed to match");
@.Hmm... some of the preceding...@>
			}
		return;
		}
	}

@ The |rst_input| procedure, which gets \.{WEAVE} ready to read the
user's \.{WEB} input, is used at the beginning of both phases one and two.

@d ABORT_ON_ERROR YES
@d DONT_ABORT_ON_ERROR NO

@d FCLOSE(file_ptr) if(file_ptr != stdin) fclose(file_ptr); file_ptr = NULL@;

@<Func...@>=
SRTN rst_input(VOID)
{
FCLOSE(prms[WEB_FILE].web.File);
FCLOSE(prms[WEB_FILE].change.File);

ini_input_prms(WEB_FILE,(outer_char HUGE *)"",ABORT_ON_ERROR);
@<Reset cur\_buffer@>;

@<Initialize change buffer@>@;

incl_depth = WEB_FILE;
input_has_ended = NO;
}

@ Prepare to read from an input buffer.  It positions the~|loc|
after~|limit| so that a new line will be sure to be read next.

@<Reset cur\_buffer@>=

limit=cur_buffer; loc=cur_buffer+1; cur_buffer[0]=@' '@;

@
@<Glob...@>=

static INPUT_PARAMS change_params0 = {FORTRAN,OUTER,NO};

@
@<Initialize change...@>=
{
  cur0_prms = cur_prms.change;
  changing = YES;
  change_params = change_params0; // Reset to default values.
  prime_the_change_buffer(); 
  @<Reset cur\_buffer@>;
}

@*1 Initializing input files.
Whenever a new input file is opened, we must
allocate a buffer, and initialize parameters.  This routine initializes
both the \WEB\ file and the change file for a particular include level.
@^system dependencies@>

@<Func...@>=
boolean ini_input_prms FCN((ilevel,path,quit_on_error))
	int ilevel C0("Present level of input files.")@;
	outer_char HUGE *path C0("Colon-delimited path list")@;
	boolean quit_on_error C1("Abort flag.")@;
{
INPUT_PRMS HUGE *p = &prms[ilevel];
CUR_PRMS old_prms;
boolean web_level = BOOLEAN(ilevel==WEB_FILE);

old_prms = cur_prms; // Save state in case of error.

/* Initialize this here in case of error messages. */
cur_prms.web = &p->web;
cur_prms.change = &p->change;

/* Initialize both input and change files; abort if error. */
if(!(ini0_input_prms(cur_prms.web,path,OC("input"),quit_on_error,
	(SEQUENCES *)(web_level ? wt_style.input_ext.web :
		wt_style.input_ext.hweb)) &&   
     ini0_input_prms(cur_prms.change,path,OC("change"),quit_on_error,
	(SEQUENCES *)(web_level ? wt_style.input_ext.change :
			wt_style.input_ext.hchange)))) 
		{
		cur_prms = old_prms; // Restore old state if error.
		return NO; 
		}

/* For definiteness we set |cur0_prms| to the web input file. */ 
cur0_prms = cur_prms.web;
loc = cur_buffer;

/* Remember the name of the include file, for use by \WEAVE. */
STRCPY(this_include_file,web_level ? 
	(CONST outer_char *)"" : p->web.File_name);

return YES;
}

@ This function initializes either a web file or a change file.
@a
boolean ini0_input_prms FCN((p0,path,file_type,quit_on_error,extensions))
	INPUT_PRMS0 HUGE *p0 C0("")@;
	outer_char HUGE *path C0("")@;
	outer_char file_type[] C0("")@;
	boolean quit_on_error C0("")@;
	SEQUENCES *extensions C1("")@;
{
cur0_prms = p0; /* In case of error messages. */

/* If we've never opened this level before, allocate appropriate space. */
if(p0->Buffer == NULL)
	{
	ALLOC(ASCII,p0->Buffer,ABBREV(buf_size),buf_size,0);
	p0->Buffer_end = p0->Buffer + buf_size - 2;
	}

/* Initialize location pointers and flags. */
loc = p0->Limit = p0->Buffer;
p0->Line = p0->Num_in_buffer = 0;
p0->Scanning_C_cmnt = p0->Last_was_empty
  = p0->Continuing_line = p0->Last_was_continued = NO;

/* --- Open file (but not if it's already open) --- */
if(!p0->File && 
   (p0->File=xopen(p0->File_name,path,extensions,OC("r"))) == NULL)
	{
	if(quit_on_error)
		{
		char temp[100];

		sprintf(temp,"!! Can't open %s%s file ",
			*p0->File_name ? "" : "(null) ",file_type);
		FATAL(temp,*p0->File_name ? p0->File_name :
			wt_style.null_file_name); 
@.Can't open input file@>
@.Can't open change file@>
		}
	else 
		{
		err_print(C,"Can't open include %s file \"%s\"",
			file_type,p0->File_name);
		}

	return NO; // Couldn't open file.
	}

return YES; // Opened file successfully.
}

@ This general routine attempts to open a file by searching through a path.
@a
FILE *xopen FCN((file_name,path,extensions,iomode))
	outer_char *file_name C0("")@;
	outer_char HUGE *path C0("")@;
	SEQUENCES *extensions C0("")@;
	CONST outer_char *iomode C1("")@;
{
outer_char HUGE *p1;
FILE *file_ptr;
outer_char total_name[2*MAX_FILE_NAME_LENGTH];
outer_char prefix_end_str[2];

if(!*file_name)	return FOPEN(wt_style.null_file_name,iomode);

if(*iomode=='r' && STRCMP(file_name,"stdin")==0) return stdin;
else if(*iomode=='w' && STRCMP(file_name,"stdout")==0) return stdout;

/* If there's no path, we just try to look in the present directory. */
if(!(path && *path)) return x0open(file_name,extensions,iomode);

prefix_end_str[0] = prefix_end_char;
prefix_end_str[1] = '\0';

/* Hunt through the path. */
while((p1=(outer_char HUGE *)STRCHR(path,':')) != NULL)
	{
	*p1 = '\0';
	STRCPY(total_name,path);
	*p1 = ':';
	if(*(p1-1) != prefix_end_char) STRCAT(total_name,prefix_end_str);
	STRCAT(total_name,file_name);
	if((file_ptr=x0open(total_name,extensions,iomode)) != NULL) 
		return file_ptr;
	path = p1 + 1;
	}

return NULL; // Couldn't open any file.
}

@ Here we attempt to open a file with a specific file name.  When the
\.{-e}~option is in effect, we must scan through the list of 
possible extensions in order to ascertain whether one of the possible files
can be opened.  
@a
FILE *x0open FCN((file_name,extensions,iomode))
	outer_char *file_name C0("")@;
	SEQUENCES *extensions C0("")@;
	CONST outer_char *iomode C1("")@;
{
int k;

/* If it has a dot in it, it's always interpreted literally.  If it didn't
have a dot, then if the `\.{-e}'~option isn't in effect it will already
have had the `\.{.web}' extension added to it, so it will now have a dot.
(So presumably the last option of the \&{if} is redundant?) */
if(STRCHR(file_name,wt_style.ext_delimiter)!=NULL || !try_extensions) 
	return FOPEN(file_name,iomode);

/* At this point, the file name didn't have a dot and the `\.{-e}'~option
is in effect.  Make trial file names from the list of extensions and try to
open them one at a time until one matches. */
for(k=0; k<extensions->n; k++)
	{
	outer_char full_name[MAX_FILE_NAME_LENGTH];
	FILE *file_ptr;

	if(NSPRINTF(full_name,"%s%c%s",
		file_name,wt_style.ext_delimiter,extensions->string[k]) >= 
		MAX_FILE_NAME_LENGTH) OVERFLW("Extended file name","");

	file_ptr = FOPEN(full_name,iomode);

	if(file_ptr)
		{
		STRCPY(file_name,full_name); /* If we don't do this, the
information messages aren't as informative as they could be. */
		return file_ptr; // Opened a file successfully.
		}
	}

return NULL; // Failed to open the file.
}

@ The |get_line| procedure is called when |loc>limit|; it
puts the next line of merged input into the buffer and updates the other
variables appropriately. A space is placed at the right end of the line.
This procedure returns |!input_has_ended| because we often want to check
the value of that variable after calling the procedure.

If we've just changed from the |cur_file| to the |change_file|, or if
the |cur_file| has changed, we tell \.{TANGLE} to print this
information in the output file by means of the |prn_where| flag.

@<Common...@>=

sixteen_bits module_count; /* the current module number */

BUF_SIZE max_modules; /* greater than the total number of modules */
boolean HUGE *chngd_module; /* Dynamic array: Is the module changed? */

boolean prn_where = NO; /* tells \.{TANGLE} to print line and file info */
boolean return_toggle = NO; /* Switch used for sending back an `\.{@@i}'
				when |toggle_includes| is on. */
boolean toggling = NO; /* In the middle of a toggle include? */
boolean popped = NO; /* After popping the stack? */
boolean no_more_input = NO; /* Temporary replacement for |input_has_ended|. */

int tracing; /* For debugging \.{WEAVE}. */

@
@<Allocate dynamic...@>=

ALLOC(boolean,chngd_module,ABBREV(max_modules),max_modules,0);

@*1 Getting the next line.
Input the next line.

@<Fun...@>=
boolean get_line(VOID)
{
if(return_toggle) @<Restore next line and |goto process_line|@>@;

restart:
  if (changing) chngd_module[module_count] = YES;
  else @<Read from |cur_file| and maybe turn on |changing|@>;

if (changing) 
	{
	@<Read from |change_file| and maybe turn off |changing|@>;

	if (!changing) 
		{
		chngd_module[module_count]=YES; goto restart;
		}
	}

process_line:
  loc = cur_buffer; *limit = @' ';

if(return_toggle) @<Send back a toggle command@>@;

if (*cur_buffer==@'@@')
	switch(*(cur_buffer+1))
		{
	   case @'i':
	   case @'I':
		@<Process an \.{\AT!i} command@>@;
		break;
		}

return (boolean)(!input_has_ended);
}

@
@<Process an \.{\AT!i}...@>=

if( *(cur_buffer+1)==@'I' && program==weave && (skip_includes ||
		(toggle_includes&&CUR_FILE==WEB_FILE)) ) 
	{
	if(skip_includes) 
		{
		loc = limit + 1; // Turn whole line into null.
		goto restart;
		}
	else if(toggle_includes && CUR_FILE==WEB_FILE)
		{
		toggling = YES;
		@<Send back a tog...@>@;
		}
	}
else @<Push stack and go to |restart|@>@;

@ Process an \.{\AT!o} command.
@<Unused@>=
{
outer_char new_file_name[MAX_FILE_NAME_LENGTH];

if(program==weave || phase==1) goto restart;

loc = cur_buffer + 2; // Position after \.{@@o}.

/* Look for the name of the new output file. */
if(!get_fname(new_file_name))
	ERR_PRINT(C,"Output file name not given");
@.Output file name not given@>
else
	{
	fclose(out_file);
	strcpy(output_file_name,new_file_name);
	open_out();
	}

goto restart;
}

@ An~`\.{@@i}'---|toggle_output|--- is returned before and after
an include line that is to be processed but not output (when
|toggle_includes == YES|). Before we send it back, we must save the line in
the buffer, because we must process it the next time we come back in for a
line. 

@<Send back a toggle...@>=
{
return_toggle = YES;
stored_line_length = PTR_DIFF(size_t,limit,cur_buffer);
stored_line = GET_MEM("stored_line",stored_line_length+1,ASCII); /* We
	allocate one extra so we don't have to handle the special case of a
	zero-length line, for which |FREE_MEM| would complain. */
STRNCPY(stored_line,cur_buffer,stored_line_length);
loc = limit = cur_buffer;
*limit++ = @'@@'; @+ *limit++ = '\001'; @+ *limit = @' '; 
return YES;
}

@ We need a place to hold that line.
@<Other def...@>=

static int stored_line_length;
static ASCII HUGE *stored_line; /* Allocated dynamically. */

@ When we come back after sending a |toggle_include| command, we must get
back the previous line that was in the buffer.

@<Restore next line...@>=
{
return_toggle = NO;
if(popped && no_more_input) {input_has_ended = YES; return NO;}
STRNCPY(cur_buffer,stored_line,stored_line_length);
FREE_MEM(stored_line,"stored_line",stored_line_length,ASCII);
limit = cur_buffer + stored_line_length;
*limit = @' ';
if(popped) 
	{
	popped = NO;
	goto popped_stack;
	}
else if(toggling) {goto push_stack;}
else goto process_line;
}

@ When an \.{@@i}~line is found in the |cur_file|, we must temporarily
stop reading it and start reading from the named include file.  The
\.{@@i}~line should give a complete file name with or without~\.{"..."};
\.{WEB} will not look for include files in standard directories as the
\cee\ preprocessor does when a \.{\#include <filename>} line is found.
Also, the file name should only contain visible ASCII characters,
since the characters are translated into ASCII and back again.

Optionally, one may also name a new change file.  As for the command line,
the format is \.{@@i include\_file [change\_file]}.

The next arrays hold the last and current names of the include file, for
use by \WEAVE\ in printing out what file goes with what section.

@<Other...@>=

outer_char last_include_file[MAX_FILE_NAME_LENGTH] = "", 
	this_include_file[MAX_FILE_NAME_LENGTH] = "";

@
@<Push stack and...@>= 
@{
boolean found_include;

@b
push_stack:
 loc = cur_buffer + 2; // Position after \.{@@i}.
  
if(++incl_depth >= MAX_INCLUDE_DEPTH)
	{
	incl_depth--;
	err_print(C,"Too many nested includes; %d allowed",MAX_INCLUDE_DEPTH); 
@.Too many nested includes@>
	goto restart;
	}

/* Look for the name of a \WEB\ file to include. */
if(!(found_include=get_fname(cur_file_name))) 
	ERR_PRINT(C,"Include file name not given");
@.Include file name not given@>
  else
	{ // Found a \WEB\ file name; now look for change file name.
	if(!get_fname(change_file_name)) 
		{ /* No change file name specified; obtain it from the
last level. */
		INPUT_PRMS *p_lower = &prms[incl_depth-1];
		INPUT_PRMS0 *p0_lower = &p_lower->change;

		STRCPY(change_file_name,p0_lower->File_name);
		change_file = p0_lower->File;
		change_params = p_lower->input_params;
		}
	}

if(found_include)
	{
	if(ini_input_prms(CUR_FILE,incl.list,DONT_ABORT_ON_ERROR))
		{
		if(cur_prms.change->File != prms[incl_depth-1].change.File)
			@<Initialize change...@>@; // New change file.
		else *cur_prms.change = prms[incl_depth-1].change;
			// Still using the old change file.

		cur_line = 0;
		prn_where = YES;
		CLR_PRINTF(include_file,(" (%s",cur_file_name)); /* Tell the
terminal where we're reading from. */
		}
	else 
		{ /* Failed to open include file. */
	        incl_depth--;
		}
	 }

goto restart;
}

@ Read a file name from an \.{@@i}~line.  One annoyance is the possibility
of embedded comments.
@a
boolean get_fname FCN((file_name))
	outer_char HUGE *file_name C1("")@;
{
ASCII HUGE *j;
outer_char HUGE *k;

skip_white:

/* Skip over leading white space and optional quotes. */
while (loc<=limit && (*loc==@' '||*loc==@'\t'||*loc==@'"')) loc++;

/* If we've hit the end of the buffer, we're done, and we didn't find
anything. */ 
if(loc >= limit) return NO;

@<Process comment in include line@>@;

k = file_name; j=loc;

/* Terminate scan by white space or quotes. */
while (*loc!=@' '&&*loc!=@'\t'&&*loc!=@'"') *k++ = XCHR(*loc++);
TERMINATE(k,0);

/* On certain systems, underscores aren't allowed in file names. */
@#ifdef MVS
for (k = file_name; *k; k++)
   if (*k == '_')
     *k = '@@';
@#endif // |MVS|

add_prefix(file_name); // Attach a directory prefix.

return YES;
}

@
@<Process comment in include...@>=
{
if(*loc==@'/')
	{
	if(*(loc+1) == @'/')
		{ /* Short comment */
		loc = limit+1;
		return NO;
		}

	if(*(loc+1) == @'*')
		{ /* Long comment */
		for(loc += 2; loc <= limit; loc++)
			if(*loc==@'*' && *(loc+1)==@'/') 
				{
				loc += 2;
				goto skip_white;
				}

		ERR_PRINT(C,"Can't continue comments on @@i lines");
		}
	}
}

@ If the include file name has no directory prefix and there was a web file
prefix, then attach the latter to the former.

@a
SRTN add_prefix FCN((file_name))
	outer_char HUGE *file_name C1("")@;
{
outer_char temp[MAX_FILE_NAME_LENGTH];

xpnd_file_name(file_name); // Expand possible environmental prefix.

if(*wbprefix && STRRCHR(file_name,prefix_end_char)==NULL)
	{
	if(NSPRINTF(temp,"%s%s",wbprefix,file_name) >=
		MAX_FILE_NAME_LENGTH) OVERFLW("Path/file_name","");

	STRCPY(file_name,temp);
	}
}

@ The following function emulates VMS' expansions of logical names. It's
assumed that the file names in an \.{@@i} command look like \.{ENV:name},
where \.{ENV}~is an environmental variable defined with \.{setenv}.
\.{ENV}~should expand to a subdirectory, without a trailing slash.
@a
SRTN xpnd_file_name FCN((name))
	outer_char HUGE *name C1("")@;
{
outer_char temp[MAX_FILE_NAME_LENGTH],env_prefix[MAX_FILE_NAME_LENGTH];
outer_char *pc,*px,*qx;
CONST char *separator;
int n;
boolean expanded;

#ifdef vms
	return; // VAX/VMS does its own expansions of logical names.
#else

#if !HAVE_GETENV
   err_print(C,"Sorry, this machine doesn't support environment variables");
   return;
#else

/* Is there a logical name prefix? */
if((pc=OC(STRCHR(name,':'))) == NULL) return;

/* Isolate the prefix. */
STRNCPY(env_prefix,name,n=pc-name);
TERMINATE(env_prefix,n);

/* Recursively expand the prefix. |px|~will have the last non-null name. */
expanded = NO;
for(px=env_prefix; px; px=qx)
	{
	if((qx=GETENV(px)) == NULL) break;
	if(STRCMP(qx,env_prefix) == 0)
		{
		err_print(C,"Infinite recursion in definition of \
environmental variable \"%s\"",px=env_prefix);
		expanded = NO;
		break;
		}
	expanded = YES; /* At least one expansion of the logical name was
made. */
	}

/* If the prefix wasn't expandable, or if it turned into an infinite
recursion, do nothing. */
if(!expanded) return;

/* Otherwise, |px|~has the last expansion of the name. */
separator = 
#ifdef ibmpc
	"\\"
#else
	"/"
#endif /* |ibmpc| */
;
if(NSPRINTF(temp,"%s%s%s",px,separator,pc+1) >=
		MAX_FILE_NAME_LENGTH) 
	OVERFLW("Expandable file name","");
STRCPY(name,temp);

#endif // |HAVE_GETENV|
#endif // |vms|
}

@ 
@<Read from |cur_file|...@>= 
{
popped = NO;

if(cur_prms.web->Line == 0)
	if(ignored_cmnts()) goto fin_read;
	else goto pop_or_quit;

while (!input_ln(INPUT_FILE)) 
	{ /* pop the stack or quit */
	pop_or_quit:
	    prn_where=YES;

	if(incl_depth==WEB_FILE) {input_has_ended = YES; break;}
	else 
		{ /* Tidy up the include level we're about to leave. */
		if(cur_prms.web->File != prms[incl_depth-1].web.File)
			{FCLOSE(cur_prms.web->File);}

		if(cur_prms.change->File != prms[incl_depth-1].change.File)
			{FCLOSE(cur_prms.change->File);}
		else prms[incl_depth-1].change = *cur_prms.change;
	
		cur0_prms->File = NULL; 
		CLR_PRINTF(include_file,(")")); /* Tell the terminal we're
finished with this web input file. */

/* Pop the stack here. */		
		incl_depth--;
		cur_prms.web = &prms[incl_depth].web;
		cur_prms.change = &prms[incl_depth].change;

		if(incl_depth == WEB_FILE && toggle_includes && toggling)
				{
				toggling = NO; 
				return_toggle = YES;
				}

		STRCPY(this_include_file,(incl_depth==WEB_FILE) ? 
			(CONST outer_char *)"" : cur_file_name);

		} 
	  }

fin_read:
if(return_toggle)
	{
	no_more_input = input_has_ended;
	input_has_ended = NO;
	popped = YES;
	@<Send back a tog...@>@;
	}

popped_stack:
 if (!input_has_ended)
  if (limit==change_limit-change_buffer+cur_buffer)
    if (cur_buffer[0]==change_buffer[0])
      if (change_limit>change_buffer) chk_change();
}

@ Here we look at the beginning material in the include file.  If the file
begins with~`\.{@@z}', then everything up to and including a line beginning
with~`\.{@@x}' is skipped.  

@<Func...@>=

boolean ignored_cmnts(VOID)
{
boolean limbo_material;

/* Read the first line of file. */
if(!input_ln(INPUT_FILE)) return NO;

/* Check for possible limbo material. 	If so, skip all lines up to
an~`\.{@@x}'. */
limbo_material = BOOLEAN(cur_buffer[0] == @'@@' && cur_buffer[1] == @'z');
if(limbo_material)
do
	{
	if(!input_ln(INPUT_FILE))
		{
		CLR_PRINTF(warning,("\n! File ended during \
skip_limbo.  Limbo material that begins with @@z must be terminated by \
@@x."));
		return NO;
		}
	}
while(!(cur_buffer[0] == @'@@' && cur_buffer[1] == @'x'));

/* If there was limbo material, at this point the line beginning
with~`\.{@@x}' is in the buffer.  The next operation is to read another
line, which starts the proper part of the include file.  If there was no
limbo material, the first line of the file is already in the buffer. Thus,
after the following operation we'll always have the first proper line of
the file in the buffer. */
if(limbo_material && !input_ln(INPUT_FILE)) return NO; 

return YES; // Successfully skipped comments.
}

@ 
@<Read from |change_file|...@>= 
{
  if (!input_ln(CHANGE_FILE)) 
	{
	    ERR_PRINT(C,"Change file ended without @@z");
@.Change file ended...@>
	    cur_buffer[0]=@'@@'; cur_buffer[1]=@'z'; limit=cur_buffer+2;
	  }

 if (limit>cur_buffer+1) /* check if the change has ended */
  if (cur_buffer[0]==@'@@') 
	{
	    @<Lowerc...@>;
	    @<Check for erron...@>;

	    if (cur_buffer[1]==@'x' || cur_buffer[1]==@'y') 
		{
	        loc=cur_buffer+2; ERR_PRINT(C,"Where is the matching @@z?");
@.Where is the match...@>
		 }
	    else if (cur_buffer[1]==@'z') 
		{
	      prime_the_change_buffer(); prn_where=YES;
		 }
	  }
}

@ At the end of the program, we will tell the user if the change file
had a line that didn't match any relevant line in |web_file|.

@<Funct...@>=
SRTN chk_complete(VOID)
{
  if (change_limit != NULL) 
	{ /* |changing| is |NO| */
    STRNCPY(cur_buffer,change_buffer,
	PTR_DIFF(size_t,change_limit,change_buffer)+1); 
    loc = limit = PTR_DIFF(size_t,change_limit,change_buffer) + cur_buffer;
    changing=YES; 
    ERR_PRINT(C,"Change file entry did not match");
  @.Change file entry did not match@>
	  }
}

@* MEMORY ALLOCATION.
Almost all memory is allocated dynamically. This
allows one to customize the tables if necessary; default sizes can be
overridden by the command-line option~``\.{-y}'', which can also be used in
the ini file. Dynamic allocation also ensures that the pointer to the array
is |HUGE|, and that sometimes matters for personal computers.

@i mem.hweb

@ The memory allocation routine quits if it can't find anything.

@d MAX_SIZE_T ((BUF_SIZE)(size_t)(~(0L))) // Maximum argument to |calloc|.

@<Func...@>=

BUF_SIZE total_mem = 0; /* Current total dynamically allocated memory. */
BUF_SIZE max_mem = 0; /* The maximum bytes that were allocated. */

void HUGE *get_mem0 FCN((why,nunits,nsize))
	CONST outer_char why[] C0("Reason for request")@;
	BUF_SIZE nunits C0("Number of units to allocate.")@;
	size_t nsize C1("Size of each unit.")@;
{
void HUGE *p; /* With certain compilers such as the |SGI|, |void| is
		translated into |char|; see \.{proto.hweb}. */
BUF_SIZE nbytes;

if(nunits==0) return NULL; /* Should this ever happen? */
if(nsize==0) CONFUSION("get_mem0","Nsize = 0 requested");

#if !NON_ANSI_CALLOC
/* For ANSI, the prototype for |calloc| is |void *calloc(size_t,size_t)|. */
	if(nunits > MAX_SIZE_T)
		{
	err_print(C,"get_mem0: Can't request %lu units; used max of %lu",
			nunits,MAX_SIZE_T);
		nunits = MAX_SIZE_T;
		}
#endif /* |ANSI_CALLOC| */

if( (p=(void HUGE *)CALLOC(nunits,nsize)) == NULL)
	{
	char temp[250];

	sprintf(temp,"\n!!! NO MORE MEMORY (\"%s\")!!! \
[Requesting %lu unit(s) of size %lu byte(s); allocated %lu bytes so far.]  \
Try using the -y option to reduce the sizes of internal tables.",
		why,nunits,(BUF_SIZE)nsize,total_mem);
	FREE(byte_mem); // Kludge to try to make it go out gracefully.
	FATAL(temp,"");
	}

/* Keep track of total allocation. */
nbytes = nunits*nsize;
total_mem += nbytes; 
max_mem = MAX(max_mem,total_mem);

#ifdef mac
	lmemset(p,0,nbytes); /* For |lmalloc|, must zero explicitly. */
#endif

if(show_mem && nbytes >= show_size)
	show_alloc('+',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);

return p; /* The allocated memory area. */
}

@ Here we display the details of the memory allocation.
@a
SRTN show_alloc FCN((c,why,nunits,nsize,nbytes,p,total_mem))
	outer_char c C0("Either plus or minus")@;
	CONST outer_char why[] C0("Reason for request")@;
	BUF_SIZE nunits C0("Number of units")@;
	BUF_SIZE nsize C0("Size of each unit.")@;
	BUF_SIZE nbytes C0("Bytes allocated")@;
	void HUGE *p C0("Start of allocated area")@;
	BUF_SIZE total_mem C1("Total bytes currently allocated")@;
{
printf("\"%s\": %c(%lu x %lu) = %c%lu ",
	    why,c,nunits,nsize,c,nbytes);
ptr_range(p,nbytes);
printf("(%lu total)\n",total_mem);
}

@ Because not all compilers understand the \.{\%p}~format command, and
since different users may wish to customize the form of the pointer range
for an allocation, we provide this function.

If one wanted, for the Sun etc.\ he could use |$TRANSLIT| to turn~\.p
into~\.d, for example.

@d PTR_BASE "[%p,%p) " /* To style file? */

@a
SRTN ptr_range FCN((p,nbytes))
	void HUGE *p C0("Start of the allocated space.")@;
	BUF_SIZE nbytes C1("Length of the allocation")@;
{
static char ptr_string[] = 
#ifdef ibmpc
	PTR_BASE
#else
	""
#endif
;

printf(ptr_string,p,(char HUGE *)p + nbytes);
}

@ We free memory through an intermediate routine so we can keep track of
the total memory allocations.
@a
SRTN free_mem0 FCN((p,why,nunits,nsize))
	void HUGE *p C0("Pointer to deallocate")@;
	CONST outer_char why[] C0("Reason for request")@;
 	BUF_SIZE nunits C0("Number of units to deallocate.")@;
	size_t nsize C1("Size of each unit.")@;
{
BUF_SIZE nbytes;

/* If things are working correctly, |p|~should have been previously
allocated. */
if(p == NULL) CONFUSION("free_mem0","Attempting to deallocate NULL pointer");

/* Keep track of total allocation. */
nbytes = nunits*nsize;
total_mem -= nbytes; 

if(show_mem && nbytes >= show_size)
	show_alloc('-',why,nunits,(BUF_SIZE)nsize,nbytes,p,total_mem);

FREE(p);
}

@ For debugging, we have some variables that say whether to display the
dynamic memory allocations as they occur. To turn on the display, use the
command-line option~\.{-sm}. A numeric argument changes |show_size|---e.g.,
\.{-sm100} shows all memory allocations whose size is $\ge 100$ bytes.

@d SHOW_MEM 0	/* Don't display by default. */

@<Glob...@>=

boolean show_mem = SHOW_MEM;
BUF_SIZE show_size = 10000; /* Display for |nbytes >= show_size|. */

@ Here we set up for dynamic memory allocation. The information about the
minimum allowed, maximum allowed, and default value for the length or value
of a variable is held in a |MEM| structure. The default value can be
overridden with the command-line option~\.{-y}. 

@m ID_FLAG 10240 /* \bf DO NOT MESS WITH THIS NUMBER!. */
@m ID_FLAG1 $EVAL(ID_FLAG-1)

@<Common...@>=

/* Ideally, the following numbers should be large enough to handle both
\FTANGLE\ and \FWEAVE. In the comments, we show some characteristic
statistics. */  

/* \.{Machine-dependent:} Machines with limited memory. */
#if SMALL_MEMORY
	#define DFLT_BYTES 10000 /* \.{fweave fweave} $\approx$ 23,300. */
	#define DFLT_BUF_SIZE 1500
	#define DFLT_C_BUF_SIZE 200
	#define DFLT_FMT_SIZE 200
	#define DFLT_MSG_SIZE 1000
	#define DFLT_DELTA_DOTS 20
	#define DFLT_MAX_LBLS 20
	#define DFLT_LINE_LENGTH 80
	#define DFLT_LONGEST_NAME 1000
	#define DFLT_MAX_EXPR_CHARS 500
	#define DFLT_MAX_MARGS 20
	#define DFLT_MAX_MODULES 400
	#define DFLT_MBUF_SIZE INT_MAX
	#define DFLT_MAX_NAMES 1000 /* \.{fweave fweave} $\approx$ 3,300. */
	#define DFLT_MAX_REFS 2500 /* \.{fweave ftangle} $\approx$ 5,850. */
	#define DFLT_SBUF_LEN 300
	#define DFLT_STACK_SIZE_T 50
	#define DFLT_STACK_SIZE_W 210 /* \.{fweave fweave} $\approx$ 200. */
	#define DFLT_MAX_SCRAPS 1000 /* \.{fweave fweave} $\approx$ 900. */
	#define DFLT_MAX_TOKS_T 50000L // \.{ftangle fweave} $\approx$ 92,000.
	#define DFLT_MAX_TOKS_W 6000 /* \.{fweave fweave} $\approx$ 6,700. */
	#define DFLT_MAX_DTOKS 2500
	#define DFLT_MAX_TEXTS 2500 /* \.{fweave fweave} $\approx$ 4,500. */
	#define DFLT_MAX_DTEXTS 100
	#define DFLT_NUM_FILES 15
	#define DFLT_OP_ENTRIES $EVAL(128+PREDEFINED_DOTS+5)
	#define DFLT_X_BUF_SIZE 80
#else /* Large limits. */
	#define DFLT_BYTES 90000L
	#define DFLT_BUF_SIZE 1500
	#define DFLT_C_BUF_SIZE 255
	#define DFLT_FMT_SIZE 500
	#define DFLT_MSG_SIZE 2000
	#define DFLT_DELTA_DOTS 20
	#define DFLT_MAX_LBLS 20
	#define DFLT_LINE_LENGTH 80
	#define DFLT_LONGEST_NAME 10000
	#define DFLT_MAX_EXPR_CHARS 500
	#define DFLT_MAX_MARGS 20
	#define DFLT_MAX_MODULES 2000
	#define DFLT_MBUF_SIZE 50000L
	#define DFLT_MAX_NAMES 4000
	#define DFLT_MAX_REFS 20000
	#define DFLT_SBUF_LEN 300
	#define DFLT_STACK_SIZE_T 50
	#define DFLT_STACK_SIZE_W 400
	#define DFLT_MAX_SCRAPS 10000
	#define DFLT_MAX_TOKS_T 150000L
	#define DFLT_MAX_TOKS_W 25000
	#define DFLT_MAX_DTOKS 25000
	#define DFLT_MAX_TEXTS ID_FLAG1
	#define DFLT_MAX_DTEXTS 500
	#define DFLT_NUM_FILES 15
	#define DFLT_OP_ENTRIES $EVAL(128+PREDEFINED_DOTS+15)
	#define DFLT_X_BUF_SIZE 80
#endif /* Limited memory. */


@ The following list must be kept sorted by abbreviation!
@<Glob...@>=

MEM mem[] = {
	{ABBREV(max_bytes),1,
		1000,DFLT_BYTES,ULONG_MAX}, /* |"b"|.  |max_bytes|: the
number of bytes in identifiers, index entries, and module names. */
	{ABBREV(buf_size),1,
		500,DFLT_BUF_SIZE,2000}, // |"bs"|.  |change_buffer| etc.
	{ABBREV(C_buf_size),1,
		10,DFLT_C_BUF_SIZE,1000},// |"cb"|. |C_buf_size|: see |C_putc|.
	{ABBREV(cmd_fsize),1,
   	   100,DFLT_FMT_SIZE,UL(65536L)}, // |"cf"|.|cmd_fsize|: see |out_cmd|.
	{ABBREV(cmd_size),1,
	   100,DFLT_MSG_SIZE,UL(65536L)}, // |"cg"|. |cmd_size|: see |out_cmd|
	{ABBREV(delta_dots),sizeof(DOTS),
		20,DFLT_DELTA_DOTS,255}, /* |"d"|.  |delta_dots|: Number of
additional entries to reallocate for |dots| if necessary. */
	{ABBREV(max_dtoks),sizeof(eight_bits),
		1000,DFLT_MAX_DTOKS,ULONG_MAX}, // |"dt"|.  |max_dtoks|.
	{ABBREV(dtexts_max),sizeof(text),
		100,DFLT_MAX_DTEXTS,ID_FLAG1}, // |"dx"|.  |dtexts_max|.
	{ABBREV(stck_size_t),sizeof(output_state),
		10,DFLT_STACK_SIZE_T,100}, // |"kt"|.  Tangle's |stck_size|.
	{ABBREV(stck_size_w),sizeof(output_state),
		50,DFLT_STACK_SIZE_W,1000}, // |"kw"|.  Weave's |stck_size|.
	{ABBREV(max_lbls),sizeof(BEGUN),
		5,DFLT_MAX_LBLS,255}, // |"lb"|. |max_lbls|.
	{ABBREV(line_length),1,
	   60,DFLT_LINE_LENGTH,255}, /* |"ll"|.  |line_length| for
\FWEAVE's output. */
	{ABBREV(longest_name),1,
		3*MAX_FILE_NAME_LENGTH, DFLT_LONGEST_NAME, UL(50000L)}, 
/* |"ln"|.  |longest_name|: module names and strings shouldn't be longer
than this. */   
	{ABBREV(max_expr_chars),1,
		25,DFLT_MAX_EXPR_CHARS,UL(65536L)}, // |"lx"|.  |max_expr_chars|.
	{ABBREV(max_modules),sizeof(boolean),
		100,DFLT_MAX_MODULES,ID_FLAG1}, /* |"m"|.  |max_modules|:
larger than the max number of modules. */ 
	{ABBREV(max_margs), sizeof(sixteen_bits),
		1, DFLT_MAX_MARGS, 255}, // |"ma"|.  |max_margs|.
	{ABBREV(mbuf_size),1,
		5000,DFLT_MBUF_SIZE,UL(65536L)}, // |"mb"|. |mbuf_size|.
	{ABBREV(max_names),sizeof(NAME_INFO)+sizeof(name_pointer),
		500,DFLT_MAX_NAMES,ID_FLAG1}, /* |"n"|.  |max_names|:
number of identifiers, strings, module names; must be less than 10240. */
	{ABBREV(num_files),sizeof(OPEN_FILE),
		1,DFLT_NUM_FILES,256}, // |"nf"|.  |num_files|.
	{ABBREV(op_entries),sizeof(OPERATOR),
	   $EVAL(128+PREDEFINED_DOTS),DFLT_OP_ENTRIES,256}, /* |"op"|.
|op_entries| */
	{ABBREV(max_refs),sizeof(xref_info),
		500,DFLT_MAX_REFS,UL(65536L)}, /* |"r"|. |max_refs|: number of
cross-references; must be less than 65536. */ 
	{ABBREV(max_scraps),sizeof(scrap),
		1000,DFLT_MAX_SCRAPS,ULONG_MAX}, // |"s"|.  |max_scraps|.
	{ABBREV(sbuf_len),sizeof(outer_char),
		100,DFLT_SBUF_LEN,1000}, // |"sb"|.  |sbuf_len|.
	{ABBREV(max_toks_t),sizeof(eight_bits),
		10000,DFLT_MAX_TOKS_T,ULONG_MAX}, /* |"tt"|.  Tangle's
|max_toks|: Total for the entire code; can be big. */
	{ABBREV(max_toks_w),sizeof(sixteen_bits),1000,
		DFLT_MAX_TOKS_W,UL(65536L)}, /* |"tw"|.  Weave's |max_toks|:
number of symbols in code texts being parsed;  must be less than 65536. */ 
	{ABBREV(max_texts),sizeof(text),
		500,DFLT_MAX_TEXTS,ID_FLAG1}, // |"x"|.  |max_texts|.
	{ABBREV(X_buf_size),1,
		10,DFLT_X_BUF_SIZE,1000},// |"xb"|. |X_buf_size|: see |C_putc|.
	{"",0,0,0}
	};

@ This is the search routine used by the `\.{-y}'~option that matches an
abbreviation with the right element of the |MEM| structure and overrides
the default value. 

@<Func...@>=

MEM HUGE *msearch FCN((abbrev,nunits))
	CONST outer_char abbrev[] C0("Abbreviation for desired object.")@;
	BUF_SIZE nunits C1("Value.")@;
{
MEM HUGE *m;

for(m=mem; *m->abbrev; m++)
	if(STRCMP(m->abbrev,abbrev)==0)
		{
		if(nunits == 0L) return m; // Special case: just find it.

		if(nunits < m->min)
			{
CLR_PRINTF(warning,
	("! Warning (msearch:%s): nunits (%lu) < min (%lu); min used.\n",
	abbrev,nunits,m->min));
			mark_harmless;
			nunits = m->min;
			}
		else if(nunits > m->max)
			{
CLR_PRINTF(warning,
	("! Warning (msearch:%s): nunits (%lu) > max (%lu); max used\n",
	abbrev,nunits,m->max));
			mark_harmless;
			nunits = m->max;
			}
		
		m->nunits = nunits; /* Override the default value. */
		return m;
		}

CLR_PRINTF(warning,
	("! Invalid alloc abbreviation \"%s[%lu]\"\n",abbrev,nunits));
mark_harmless;
return m;
}

@ Here is the allocation routine that works with the |ALLOC| macro. It
returns a pointer to allocated memory, and also sets an|unsigned long|
variable with the number of units (not bytes) allocated.

@<Func...@>=

void HUGE *alloc FCN((abbrev,pnunits,nsize,dn))
	CONST outer_char abbrev[] C0("Abbreviation for desired object.")@;
	BUF_SIZE HUGE *pnunits C0("Pointer to returned \# of units.")@;
	size_t nsize C0("Size of object.")@;
	int dn C1("Incremental number of units to allocate.")@;
{
MEM HUGE *m = find_abbrev(abbrev);

*pnunits = m->nunits;

/* |dn| is used as a flag; if it's negative, we just obtain the number of
units. */
if(dn < 0) return NULL;
else return get_mem0(abbrev,(*pnunits)+dn,nsize);
}

@ Search through the abbreviations list to get the element.
@a
MEM HUGE *find_abbrev FCN((abbrev))
	CONST outer_char abbrev[] C1("")@;
{	
MEM HUGE *m;
outer_char temp[100];

for(m=mem; *m->abbrev; m++)
	if(STRCMP(m->abbrev,abbrev)==0) return m;

SPRINTF(100,temp,`"Bad alloc abbreviation \"%s\"",abbrev`);
CONFUSION("find_abbrev",temp);
return NULL;
}

@ Annoyingly, Microsoft doesn't supply a reallocation routine that works
with |halloc|, presumably because it doesn't do heap management with |huge|
stuff. So, we write our own. We simply allocate new space, copy the old to
the new, then free the old.

@a
#ifdef mcc

void HUGE *hrealloc FCN((old_ptr,new_size))
	void HUGE *old_ptr C0("Old buf previously allocated with |halloc|.")@;
	BUF_SIZE new_size C1("New size in bytes.")@;
{
void HUGE *new_ptr;

new_ptr = GET_MEM("hrealloc",new_size,char);

if(new_ptr == NULL)
	return NULL;

memcpy(new_ptr,old_ptr,(size_t)new_size); /* |new_size| is restricted to
  |size_t|; we should check for violation. Also, this call may copy more than
  needed. */ 
FREE_MEM(old_ptr,"old_ptr",new_size,char);

return new_ptr;
}

#endif /* |mcc| */

@* STORAGE of IDENTIFIERS and MODULE NAMES.
Both \.{WEAVE} and \.{TANGLE} store identifiers, module names and
other strings in a large array of |ASCII|s, called |byte_mem|.
Information about the names is kept in the array |name_dir|, whose
elements are structures of type \&{NAME\_INFO}, containing a pointer into
the |byte_mem| array (the address where the name begins) and other data.
A \&{name\_pointer} variable is a pointer into |name_dir|.

@<Allocate dynamic memory@>=

ALLOC(ASCII,byte_mem,ABBREV(max_bytes),max_bytes,0); // Characters of names.
byte_end = byte_mem + max_bytes - 1; // End of |byte_mem|.

ALLOC(NAME_INFO,name_dir,ABBREV(max_names),max_names,0); 
	// Information about names.
name_end = name_dir + max_names - 1; // End of |name_dir|.

ALLOC(ASCII,mod_text,ABBREV(longest_name),longest_name,1);
mod_end = mod_text+longest_name; // End of |mod_text|.

@I trunc.hweb

@ The actual sequence of characters in the name pointed to by a |name_pointer
p| appears in positions |p->byte_start| to |(p+1)->byte_start|, inclusive.
The |prn_id| macro prints this text on the user's terminal.

@d length(c) (c+1)->byte_start-(c)->byte_start // The length of a name.

@<Func...@>=
unsigned prn_id FCN((np))
	name_pointer np C1("")@;
{
ASCII_write(*np->byte_start == BP_MARKER ? 
	((BP *)np->byte_start)->Root->id : np->byte_start,Length(np));

return PTR_DIFF(unsigned,np,name_dir);
}

int Length FCN((np))
	name_pointer np C1("")@;
{
int n;
BP HUGE *bp;
TRUNC HUGE *s;
CONST ASCII HUGE *p0;
CONST ASCII HUGE *p1;

p0 = np->byte_start;
bp = (BP *)p0;

if(*(char *)bp == BP_MARKER)
	{
	s = bp->Root;
	n = s->id_end - s->id;
	}
else
	{
	p1 = (np+1)->byte_start;
	PROPER_END(p1);
	n = p1 - p0;
	}

return n;
}
	
@ The first unused position in |byte_mem| and |name_dir| is
kept in |byte_ptr| and |name_ptr|, respectively.  Thus we
usually have |name_ptr->byte_start=byte_ptr|, and certainly
we want to keep |name_ptr<=name_end| and |byte_ptr<=byte_end|.

@<Common...@>=

name_pointer name_ptr; /* first unused position in |byte_start| */
ASCII HUGE *byte_ptr; /* first unused position in |byte_mem| */

@ 
@<Initialize dynamic...@>=

CAST(name_pointer,name_dir)->byte_start=byte_ptr=byte_mem; /* position zero
			in both arrays */ 
name_ptr=name_dir+1; /* |name_dir[0]| will not be used */
CAST(name_pointer,name_ptr)->byte_start=byte_mem; /* this makes name 0 of
			length zero */ 

@ The names of identifiers are found by computing a hash address |h| and
then looking at strings of bytes signified by the |name_pointer|s
|hash[h]|, |hash[h]->link|, |hash[h]->link->link|, \dots,
until either finding the desired name or encountering the null pointer.

The hash table itself consists of |hash_size| entries of type
|name_pointer|, and is updated by the |id_lookup| procedure, which finds a
given identifier and returns the appropriate |name_pointer|. The matching
is done by the function |names_match|, which is slightly different in
\.{WEAVE} and \.{TANGLE}.  If there is no match for the identifier, it is
inserted into the table.

@d hash_size 353 /* should be prime */

@ Initially all the hash lists are empty.

@<Initialize static...@>=

hash = GET_MEM("hash",hash_size,name_pointer);
hash_end = hash + hash_size - 1;

for (h=hash; h<=hash_end; *h++=NULL) ;

@ Here is the main procedure for finding identifiers. The type of
identifier being considered is held in the global variable |word_type|;
this comes into play when |last == NULL|.

@a name_pointer
id_lookup FCN((first,last,t))
	CONST ASCII HUGE *first C0("First character of string.")@;
	CONST ASCII HUGE *last C0("last character of string plus one.")@;
	eight_bits t C1("The |ilk|; used by \.{WEAVE} only.")@;
{
  CONST ASCII HUGE *i=first; /* position in |cur_buffer| */
  int h; /* hash code */
  int l; /* length of the given identifier */
  name_pointer p; /* where the identifier is being sought */
  WORD_TYPE word_type0 = ORDINARY_ID;

if(last == NULL)
	{
	word_type0 = word_type;
	 for (last=first; *last!='\0'; last++); /* Find end of identifier. */
	}

  l = PTR_DIFF(int,last,first); /* compute the length */
  @<Compute the hash code |h|@>;
  @<Compute the name location |p|@>;
  if (p==name_ptr) @<Enter a new name into the table at position |p|@>;
  if(!(p->Language & (boolean)language)) p->ilk = t;

  p->Language |= (boolean)language; /* Record language usage. */

  switch(word_type0)
	{
	case RESERVED_WD:
		p->reserved_word |= (boolean)language;
		break;

	case INTRINSIC_FCN: 
		p->intrinsic_word |= (boolean)language;
		break;

	case KEYWORD:
		p->keyword |= (boolean)language;
		break;

	default: ; /* Avoids warning about unused |enum|. */
	}

  return p;
}

@ The following two routines |find_n| and |find_s| are for rapid debugging
of the |name_dir|. They are to be called from the debugger. |find_n| prints
information about the $n$th~identifier; |find_s| prints information about
the identifier named~|s|.

@a

sixteen_bits find_n FCN((n))
	sixteen_bits n C1("")@;
{
name_pointer np;
CONST ASCII HUGE *end;
outer_char HUGE *s;
size_t len;

np = name_dir + n;

if(np >= name_ptr) 
	{
	printf("!! n = %u exceeds nmax = %u.\n",n,name_ptr - name_dir - 1);
	return 0;
	}

PROPER_END(end);

len = end - np->byte_start; /* Length of the $n$th identifier. */
s = GET_MEM("find_n",len+1,outer_char); /* Allocate temporary area. */

STRNCPY(s,np->byte_start,len);
TERMINATE(s,len);

/* Convert from |ASCII| to the outer world; print info about id. */
to_outer((ASCII HUGE *)s);
id_info(np,(long)n,(CONST outer_char *)s);
FREE_MEM(s,"find_n",len+1,outer_char);

return n;
}

sixteen_bits find_s FCN((s))
	CONST outer_char *s C1("")@;
{
int h,l;
name_pointer p;
ASCII HUGE *a;
CONST ASCII HUGE *first, HUGE *last;
CONST ASCII HUGE *i;
sixteen_bits n = 0;

l = STRLEN(s);
a = GET_MEM("find_s",l+1,ASCII);
STRCPY(a,s);
i = first = to_ASCII((outer_char *)a);
last = first + l;

@<Compute the hash...@>@;
p=hash[h];
while (p && !(STRNCMP(first,p->byte_start,l) == 0)) p=p->link;

if(p == NULL) 
	{CLR_PRINTF(warning,("%cId \"%s\" is not in name_dir!\n", beep(1),s));}
else 
	id_info(p,(long)(n=p-name_dir),s);

FREE_MEM(a,"find_s",l+1,ASCII);

return n;
}

@I t_codes.hweb

@
@a
sixteen_bits find_id FCN((a0,a1))
	eight_bits a0 C0("")@;
	eight_bits a1 C1("")@;
{
return find_n(IDENTIFIER(a0,a1));
}

@ The information utility used in |find_n| and |find_s|.
@a
SRTN id_info FCN((np,n,s))
	name_pointer np C0("")@;
	long n C0("")@;
	CONST outer_char *s C1("")@;
{
if(n >= 0) printf(_Xx("Id %ld (0x%lx):"),n,n);
printf(" \"%s\"\n",s);
pr_lan("Language ",np->Language);
pr_lan("reserved ",np->reserved_word);
pr_lan("intrinsic",np->intrinsic_word);
pr_lan("keyword  ",np->keyword);
}

@
@<Glob...@>=
boolean info_option = NO;
boolean see_rsrvd = NO;
outer_char HUGE *rsrvd_args = NULL,HUGE *style_args = NULL;
IN_STYLE ASCII HUGE *at_codes;

@ Some info options can be executed only after dynamic memory is allocated.
After that, if no web file was specified on the command line we just
terminate gracefully.
@<Execute deferred...@>=
{
if(rsrvd_args) see_reserved(rsrvd_args);
if(style_args) see_style(style_args,NO);

if(!found_web && info_option && !at_codes) wrap_up();
}

@ Format the language dependence of a boolean variable, for debugging and
the \.{-D}~option.
@a
SRTN pr_lan FCN((name,b))
	CONST char *name C0("")@;
	boolean b C1("")@;
{
unsigned k;
boolean first = YES;

if(b==0) return;

printf("   %s = { ",name);

for(k=1; k<=$EVAL(2^^8); k<<=1)
	if(k & b) 
		{
		printf("%s%s",first ? "" : ", ",
			languages[lan_num((LANGUAGE)k)]);
		first = NO;
		}

if(first) printf("(none)");
printf(_Xx(" } (0x%x)\n"),b);
}

@ More debugging:  Print out the entire |name_dir|.
@a
BUF_SIZE prn_nd(VOID)
{
BUF_SIZE k,n = name_ptr - name_dir;

for(k=0; k<n; k++)
	{
	printf("[%d]:  ",k);
	prn_id(name_dir + k);
	putchar('\n');
	}

return n;
}

@ A simple hash code is used: If the sequence of
ASCII codes is $c_1c_2\ldots c_n$, its hash value will be
$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$

@<Compute the hash...@>=

h=*i; 

while (++i<last) h=(h+h+*i) % hash_size;

@ If the identifier is new, it will be placed in position |p=name_ptr|,
otherwise |p| will point to its existing location.

@<Compute the name location...@>=
p=hash[h];

while (p && !names_match(p,first,l,t)) p=p->link;

if (p==NULL) 
	{
	  p=name_ptr; /* the current identifier is new */
	  p->link=hash[h]; hash[h]=p; /* insert |p| at beginning of hash
						list */ 
	}

@ The information associated with a new identifier must be initialized
in a slightly different way in \.{WEAVE} than in \.{TANGLE}; hence the
|ini_p| procedure.

@<Enter a new name...@>= 
@{
  if (byte_ptr+l>byte_end) OVERFLW("bytes",ABBREV(max_bytes));
  if (name_ptr>=name_end) OVERFLW("names",ABBREV(max_names));
  STRNCPY(byte_ptr,first,l);
  (++name_ptr)->byte_start=byte_ptr+=l;
  if (program==weave) ini_p(p,t);
}

@ The names of modules are stored in |byte_mem| together
with the identifier names, but a hash table is not used for them because
\.{TANGLE} needs to be able to recognize a module name when given a prefix of
that name. A conventional binary seach tree is used to retrieve module names,
with fields called |llink| and |rlink| (where |llink| takes the place
of |link|).  The root of this tree is stored in |name_dir->rlink|;
this will be the only information in |name_dir[0]|.

Since the space used by |rlink| has a different function for
identifiers than for module names, we declare it as a |union|.


@  The binary search tree starts out with nothing in it.

@<Initialize dynamic...@>=

root = NULL;

@ The |mod_lookup| procedure finds a module name in the
search tree, after inserting it if necessary, and returns a pointer to
where it was found.

According to the rules of \.{WEB}, no module name should be a proper
prefix of another, so a ``clean'' comparison should occur between any
two names. The result of |mod_lookup| is |NULL| if this prefix condition
is violated. An error message is printed when such violations are detected.
(Note that the |LESS|, |EQUAL|, and |GREATER| conventions here are
different than those for |strcmp|; they are defined in \.{typedefs.hweb}.)

@a name_pointer
mod_lookup FCN((k,l))
	CONST ASCII HUGE *k C0("First character of name.")@;
	CONST ASCII HUGE *l C1("Last character of name.")@;
{
  LEXI c = GREATER; /* comparison between two names */
  name_pointer p = root; /* current node of the search tree */
  name_pointer q = name_dir; /* father of node |p| */

  while (p) 
	{
	    c = web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);
	    q=p;

	    switch(c) 
		{
		      case LESS: p=p->llink; continue;
		      case GREATER: p=p->rlink; continue;
		      case EQUAL: return p;
		      default: ERR_PRINT(C,"Incompatible section names"); 
				return NULL;
@.Incompatible section names@>
		    }
	  }

  return install_node(q,c,k,PTR_DIFF(int,l,k)+1);
}

@ This function is like |strcmp|, but it does not assume the strings
are null-terminated.

@a
LEXI web_strcmp FCN((j,j1,k,k1)) /* fuller comparison than |strcmp| */
	CONST ASCII HUGE *j C0("Beginning of first string.")@;
	CONST ASCII HUGE *j1 C0("End of first string plus one.")@;
	CONST ASCII HUGE *k C0("Beginning of second string.")@;
	CONST ASCII HUGE *k1 C1("End of second string plus one.")@;
{
  while (k<k1 && j<j1 && *j==*k) k++, j++;

  if (k==k1) if (j==j1) return EQUAL;
    else return EXTENSION;
  else if (j==j1) return PREFIX;
  else if (*j<*k) return LESS;
  else return GREATER;
}

@ The reason we initialized |c| to |greater| is so that |name_pointer| will
make |name_dir->rlink| point to the root of the tree when |q=name_dir|,
that is, the first time it is called.

The information associated with a new node must be initialized in a
slightly different way in \.{WEAVE} than in \.{TANGLE}; hence the
|ini_node| procedure.

@a 
name_pointer
install_node FCN((parent,c,j,name_len)) /* install a new node in the tree */
	name_pointer parent C0("Parent of new node.")@;
	int c C0("Right or left?")@;
	CONST ASCII HUGE *j C0("Where replacement text starts.")@;
	int name_len C1("length of replacement text.")@;
{
  name_pointer node=name_ptr; /* new node */
  if (byte_ptr+name_len>byte_end) OVERFLW("bytes",ABBREV(max_bytes));
  if (name_ptr==name_end) OVERFLW("names",ABBREV(max_names));

  if (c==LESS) parent->llink=node; else parent->rlink=node;

  node->llink=node->rlink=NULL;
  ini_node(node);
  STRNCPY(byte_ptr,j,name_len);
  (++name_ptr)->byte_start=byte_ptr+=name_len;
  return node;
}

@ The |prefix_lookup| procedure is supposed to find exactly one module name
that has |k..l| as a prefix. Actually the algorithm silently accepts also
the situation that some module name is a prefix of |k..l|, because the user
who painstakingly typed in more than necessary probably doesn't want to be
told about the wasted effort.

@a name_pointer
prefix_lookup FCN((k,l)) /* finds module name given a prefix */
	CONST ASCII HUGE *k C0("First char of prefix.")@;
	CONST ASCII HUGE *l C1("Last char of prefix.")@;
{
  LEXI c = GREATER; /* comparison between two names */
  short count = 0; /* the number of hits */
  name_pointer p = root; /* current node of the search tree */
  name_pointer q = NULL;
    /* another place to resume the search after one is done */
  name_pointer r = NULL; /* extension found */
  while (p) {
    c=web_strcmp(k,l+1,p->byte_start,(p+1)->byte_start);

    switch(c) {
      case LESS: p=p->llink; break;
      case GREATER: p=p->rlink; break;
      default: r=p; count++; q=p->rlink; p=p->llink;
    }

    if (p==NULL) {
      p=q; q=NULL;
    }
  }
  if (count==0) ERR_PRINT(C,"Name does not match");
@.Name does not match@>
  else if (count>1) ERR_PRINT(C,"Ambiguous prefix");
@.Ambiguous prefix@>

  return r; /* the result will be |NULL| if there was no match */
}

@ Here's a routine to be called from the debugger; it returns the directory
number and the full name of a prefix.
@a
unsigned find_prefix FCN((s))
	outer_char s[] C1("")@;
{
name_pointer r;

to_ASCII(s);
r = prefix_lookup((ASCII HUGE *)s,(ASCII HUGE *)(s+STRLEN(s)));

return r ? prn_id(r) : 0;
}

@ The last component of |name_info| is different for \.{TANGLE} and
\.{WEAVE}.  In \.{TANGLE}, if |p| is a pointer to a module name, |p->equiv|
is a pointer to its replacement text, an element of the array |text_info|.
In \.{WEAVE}, on the other hand, if |p| points to an identifier, |p->xref|
is a pointer to its list of cross-references, an element of the array
|xmem|.  The make-up of |text_info| and |xmem| is discussed in the
\.{TANGLE} and \.{WEAVE} source files, respectively; here we just declare a
common field |equiv_or_xref| as a pointer to an |ASCII|.

@* REPORTING ERRORS to the USER.
The command `|ERR_PRINT(origin,"Error message")|' will report a syntax
error to the user, by printing the error message at the beginning of a new
line and then giving an indication of where the error was spotted in the
source file.  Note that no period follows the error message, since the
error routine will automatically supply a period. The |origin| argument is
one of~|C|, |T|, |W|, |R|, or~|M|; these are translated by the macro into
things like |ERR_C|, an enumerated type that says where the error came
from.  More generally, one can say |err_print(origin,msg,args)|, where
|msg| can be formatted as for |printf| and |n|~specifies how many arguments
follow. Thus, |ERR_PRINT| is a special case of |err_print| with $n = 0$.

The actual error indications are provided by a procedure called |error|.
However, error messages are not actually reported during phase one, since
errors detected on the first pass will be detected again during the second.

@<Functions...@>=

SRTN err0_print FCN(VA_ALIST((err_origin,fmt,n VA_ARGS)))
	VA_DCL(
	ERR_ORIGIN err_origin C0("Where the error came from")@;
	CONST outer_char *fmt C0("Format of error message.")@;
	int n C2("Number of arguments to the string."))@;
{
VA_LIST(arg_ptr)@;
ASCII HUGE *k, HUGE *l; /* pointers into |cur_buffer| */
char temp[500];
boolean prn_input_buffer;
static CONST char *origin_name[] = 
	{"","COMMON","FTANGLE","FWEAVE","RATFOR","MACROS","STYLE"};
#if(NUM_VA_ARGS == 1)
	ERR_ORIGIN err_origin; 
	CONST outer_char *fmt; 
	int n;
#endif

VA_START(arg_ptr,n);

#if(NUM_VA_ARGS == 1)
	err_origin = va_arg(arg_ptr,ERR_ORIGIN);
	fmt = va_arg(arg_ptr,outer_char *);
	va_arg(arg_ptr,int);
#endif

prn_input_buffer = BOOLEAN(err_origin!=ERR_NULL);

if(prn_input_buffer && err_origin != ERR_S) putchar('\n');

set_color(RED);

if(prn_input_buffer)
	{
	sprintf(temp,"! (%s):  %s",origin_name[err_origin],fmt);
	vprintf(temp,arg_ptr);
	}
else vprintf((char *)fmt,arg_ptr);

va_end(arg_ptr);

if(prn_input_buffer) 
	if(err_origin == ERR_S)
		@<Print error location based on style file buffer@>@;
	else
		@<Print error location based on input buffer@>@;

fflush(stdout); mark_error;

mfree(); // Free up any |mod_trans| allocations.
}

@ The error locations can be indicated by using the global variables |loc|,
|cur_line|, |cur_file_name| and |changing|, which tell respectively the
first unlooked-at position in |cur_buffer|, the current line number, the
current file, and whether the current line is from |change_file| or
|cur_file|.  This routine should be modified on systems whose standard text
editor has special line-numbering conventions.  @^system dependencies@>

@d MAX_ERR_BUF 160

@<Print error location based on input buffer@>=
{
outer_char last_char = fmt[STRLEN(fmt)-1];

if(*fmt && last_char != '?' && last_char != '!')
	printf("."); /* Sometimes the second argument to |fatal| is empty,
			so the period isn't necessary. */

if(cur0_prms)
 {
if (changing) 
	{
	printf(" (l. %u of %s file ",change_line,"change");
	CLR_PRINTF(in_file,("%s)\n",change_file_name)); 
	}
else if (incl_depth==WEB_FILE) printf(" (l. %u)\n", cur_line);
else 
	{
	printf(" (l. %u of %s file ",cur_line,"include");
	CLR_PRINTF(in_file,("%s)\n", cur_file_name));
	}

l = MIN(loc,limit);

if (l>cur_buffer && cur_buffer!=NULL) 
  {
  if((BUF_SIZE)(l-cur_buffer) > buf_size)
	{
	CLR_PRINTF(error,
		("! TROUBLE IN ERROR ROUTINE.  PLEASE REPORT THIS!\n")); 
	mark_error;

	l = cur_buffer + MAX_ERR_BUF;
	}

  for (k=cur_buffer; k<l; k++)
    if (*k==@'\t') putchar(' ');
    else putchar(XCHR(*k)); /* print the characters already read */

  putchar('\n'); // Separate already read from not yet read.

  for (k=cur_buffer; k<l; k++) putchar(' '); /* Space out the next line. */
  }

if(l != NULL)
	{
	if((BUF_SIZE)(limit-l) > buf_size)
		{
		puts("! TROUBLE IN ERROR ROUTINE.  PLEASE REPORT THIS!");
		l = limit - MAX_ERR_BUF;
		}

	 for (k=l; k<limit; k++) putchar(XCHR(*k)); /* print the part not
yet read */ 
	}
if(limit != NULL)
	if (*limit==@'|') putchar('|'); // End of code text in module names.

putchar(' '); // To separate the message from future asterisks.
err_happened = YES;
 }
}

@
@<Print error location based on style file buffer@>=
{
CONST outer_char HUGE *k, HUGE *l;
extern boolean from_sprm;

printf(".  (l. %u of %s file ",s_line,"style");
CLR_PRINTF(in_file,("%s)\n",
	from_sprm ? OC("parameter buffer") : style_file_name)); 

l = MIN(sloc,slimit);

for (k=sbuf; k<l; k++)
    putchar(*k == '\t' ? ' ' : *k); // Print the characters already read.

putchar('\n'); // Separate already read from not yet read.

for (k=sbuf; k<l; k++) putchar(' '); // Space out the next line.
for (k=l; k<slimit; k++) putchar(*k); // Print the part not yet read.

putchar('\n');
}

@ When no recovery from some error has been provided, we have to wrap up
and quit as graciously as possible.  This is done by calling the function
|wrap_up| at the end of the code.

@a 
int fatal FCN((s1,s2))
	CONST outer_char s1[] C0("Message 1.")@;
	CONST outer_char s2[] C1("Message 2.")@;
{
printf("\n");
CLR_PRINTF(fatal,((char *)s1)); ERR_PRINT(NULL,s2);
history = fatal_message; 

return wrap_up(); /* It never really returns, but the compiler doesn't
			know that. */
}

@ Sometimes the program's behavior is far different from what it should be,
and \.{WEB} prints an error message that is really for the \.{WEB}
maintainance person, not the user. In such cases the program says
|confusion("indication of where we are","what went wrong")|.

Note that this function doesn't really return.  It's coded this way so
compilers don't give spurious warnings.
@a
int confusion FCN((where,why))
	CONST outer_char where[] C0("")@;
	CONST outer_char why[] C1("What went wrong.")@;
{
outer_char temp[100];

SPRINTF(100,temp,`"At %s:  %s.",where,why`);

beep(3);

return FATAL("\n!!! \
I'M CONFUSED; this shouldn't happen.  PLEASE REPORT THIS!!!  ",temp);
}
@.This shouldn't happen@>

@ An overflow stop occurs if \.{WEB}'s tables aren't large enough.
@a
SRTN overflow FCN((s,abbrev))
	CONST outer_char s[] C0("Condition that caused overflow.")@;
	CONST outer_char abbrev[] C1("Abbreviation for buffer.")@;
{
char temp[1000];
MEM HUGE *m;

if(*abbrev == '\0')
	sprintf(temp,"%s contents too long",s);
else
	{
	m = msearch(abbrev,0L);
	sprintf(temp,"Too many %s: current number is %lu, absolute max is \
%lu.  Use command-line option \"-y%s...\" to override default.",
		s,m->nunits,m->max,abbrev);
	}

FATAL("!! Sorry, CAPACITY EXCEEDED:  ",temp);
}
@.Sorry, capacity exceeded@>

@ Some implementations may wish to pass the |history| value to the
operating system so that it can be used to govern whether or not other
programs are started. Here, for instance, we pass the Unix operating system
a status of~ 0 if and only if only harmless messages were printed.
@^system dependencies@>

@<Func...@>=

#if(VMS)
	#include stsdef // Return codes.
#endif /* |VMS| */

int wrap_up() 
{
putchar('\n');

prn_time();
@<Print the job |history|@>@;
@<Close all open files@>@;

#if(VMS)
 switch(history)
	{
   case spotless: exit(STS$K_SUCCESS | STS$M_INHIB_MSG);
   case harmless_message: exit(STS$K_INFO | STS$M_INHIB_MSG);
   case error_message: exit(STS$K_ERROR | STS$M_INHIB_MSG);
   case fatal_message: exit(STS$K_SEVERE | STS$M_INHIB_MSG);
	}
#else 
 switch(history)
	{
   case spotless:
   case harmless_message:
	exit(0);

   default:
	exit(1);
	}
#endif // |VMS|

return -1; // Never really does this.
}

@ With some systems, it seems to be helpful to close the open files
explicitly, rather than letting |exit| do it.  I don't know why.

@<Close all open files@>=
{
if(cur_prms.web && cur_prms.web->File) fclose(cur_prms.web->File);
if(cur_prms.change && cur_prms.change->File) fclose(cur_prms.change->File);
}

@ 
@<Print the job |history|@>=
{
CLR_PRINTF(info,("[%s:",program==tangle ? TANGLE : WEAVE));
printf("  ");

switch (history) 
	{
   case spotless: 
	CLR_PRINTF(info,("No errors were found.")); break;

   case harmless_message:
	CLR_PRINTF(warning,
		("%cDid you see the warning message(s) above?", beep(1)));
	break;

   case error_message:
	CLR_PRINTF(error,
	     ("%cPardon me, but I think I spotted something wrong.", beep(1)));
	break;

   case fatal_message: 
	CLR_PRINTF(fatal,("%cThat was a fatal error, my friend.", beep(2))); 
	break;
	} // There are no other cases.

CLR_PRINTF(info,("]\n"));
set_color(NORMAL);
}

@ Certain errors beep the terminal.  The beeps can be turned off (and
replaced by an exclamation point) with the \.{-B} option.
@a
char beep FCN((n))
	int n C1("")@;
{
if(beeps)
	{
	for(--n; n>0; n--)
		printf("\007");
		
	return '\007'; // (Some compilers didn't understand \.{'\\a'}.)
	}
else
	return '!';
}

@ The following error routine is called if there's problem with writing.
Usually, this means that you've run out of disk space.
@<Func...@>=
SRTN out_error FCN((fcn))
	CONST outer_char fcn[] C1("")@;
{
FATAL("!! Output error (no more quota?): ",fcn);
}


@* INITIALIZING FLAGS.

@<Initialize \TeX\ cat...@>=
{
int k;

for(k=0; k<128; k++)
	TeX[k] = TeX_other;

for(k=@'A'; k<=@'Z'; k++)
	TeX[k] = TeX_letter;

for(k=@'a'; k<=@'z'; k++)
	TeX[k] = TeX_letter;

TeX[@'\\'] = TeX_escape;
TeX[@'{'] = TeX_bgroup;
TeX[@'}'] = TeX_egroup;
TeX[@'$'] = TeX_math_shift;
TeX[@'&'] = TeX_alignment_tab;
TeX[@'\n'] = TeX_eol;
TeX[@'#'] = TeX_parameter;
TeX[@'^'] = TeX_superscript;
TeX[@'_'] = TeX_subscript;
TeX[0] = TeX_ignored;
TeX[@' '] = TeX[tab_mark] = TeX_space;
TeX[@'~'] = TeX_active;
TeX[@'%'] = TeX_comment;
TeX[0177] = TeX_invalid;
}

@ We don't initialize the flags statically because it's too tedious to get
the initialization list right if one adds a flag randomly.  

@<Initialize flags@>=
{
#define FSET(flag) = flag

	active_brackets FSET(ACTIVE_BRACKETS); // Special array handling?
	all_cmnts_verbatim FSET(ALL_CMNTS_VERBATIM); /* Should \.{TANGLE} copy
					all comments? */ 
	auto_app_semi FSET(AUTO_APP_SEMI); /* For \.{WEAVE}, automatically
append a pseudo-semi to the end of \.{WEB} macro definitions? */

/* Append automatic semicolon? */
	params.Auto_semi[LN(FORTRAN)] = YES;

	params.Auto_semi[LN(FORTRAN_90)]
		= params.Auto_semi[LN(RATFOR)]
		= params.Auto_semi[LN(RATFOR_90)]
		= params.Auto_semi[LN(C)]
		= params.Auto_semi[LN(C_PLUS_PLUS)]
		= params.Auto_semi[LN(LITERAL)]
		= params.Auto_semi[LN(TEX)]
		= NO;

	params.Beeps FSET(BEEPS);

/* Do we label |do|s and |if|s with the block number? */
	params.Block_nums[LN(C)] 
		= params.Block_nums[LN(C_PLUS_PLUS)]
		= params.Block_nums[LN(LITERAL)]
		= params.Block_nums[LN(TEX)]
		= NO;

	params.Block_nums[LN(FORTRAN)] 
		= params.Block_nums[LN(FORTRAN_90)]
		= params.Block_nums[LN(RATFOR)]
		= params.Block_nums[LN(RATFOR_90)] 
		= BLOCK_NUMS;

	bslash_continued_strings FSET(BSLASH_CONTINUED_STRINGS); /* Do the
continuations of strings require a starting backslash? */
	chk_ifelse FSET(CHK_IFELSE); // Protect parenthesized strings?
	chk_stmts FSET(CHK_STMTS); // Check statement syntax in \Ratfor?
	compare_outfiles FSET(COMPARE_OUTFILES);// Compare new vs.\ old output.
	compound_assignments FSET(COMPOUND_ASSIGNMENTS); /* Do we allow things
							like \.{+=}? */
	Cpp FSET(NO); /* Do we recognize \.{C++}? */

	dbg_output FSET(DBG_OUTPUT); // Print output characters?
	deferred_macros FSET(DEFERRED_MACROS); // Allow deferred macros?

	defn_mask.outer_macros FSET(PRN_OUTER_MACROS);
	defn_mask.formats FSET(PRN_FORMATS);
	defn_mask.limbo FSET(PRN_LIMBO);
	defn_mask.macros FSET(PRN_MACROS);
	defn_mask.v FSET(PRN_V);
	defn_mask.w FSET(PRN_W);

	dot_constants FSET(DOT_CONSTANTS); // Recognize dot constants?

	params.CPP_comments[LN(C)] 
		= params.CPP_comments[LN(C_PLUS_PLUS)]
		= params.CPP_comments[LN(LITERAL)]
		= params.CPP_comments[LN(TEX)]
		= CPP_COMMENTS;

/* For \Fortran\ and \Ratfor, the \.{//}~is preempted for concatenation.
Therefore, its use for short comments must be turned on explicitly. */
	params.CPP_comments[LN(FORTRAN)] 
		= params.CPP_comments[LN(FORTRAN_90)]
		= params.CPP_comments[LN(RATFOR)]
		= params.CPP_comments[LN(RATFOR_90)] 
		= NO;

	Fortran88 FSET(FORTRAN88); /* Turn on stuff for Fortran-88? */

	params.Free_form_input[LN(FORTRAN)]
		= params.Free_form_input[LN(FORTRAN_90)]
		= params.Free_form_input[LN(LITERAL)]
		= params.Free_form_input[LN(TEX)]
		= NO;
	params.Free_form_input[LN(RATFOR)]
		= params.Free_form_input[LN(RATFOR_90)]
		= params.Free_form_input[LN(C)]
		= params.Free_form_input[LN(C_PLUS_PLUS)] 
		= YES; 

	keep_trailing_comments FSET(KEEP_TRAILING_COMMENTS); // For \TeX.

	params.In_escape[LN(FORTRAN)] 
		= params.In_escape[LN(FORTRAN_90)]
		= '&';
	params.In_escape[LN(RATFOR)] 
		= params.In_escape[LN(RATFOR_90)]
		= params.In_escape[LN(C)]
		= params.In_escape[LN(C_PLUS_PLUS)]
		= params.In_escape[LN(LITERAL)] 
		= params.In_escape[LN(TEX)] 
		= '\\';

	in_escape FSET(IN_ESCAPE); // Default continuation character.
	input_macros FSET(INPUT_MACROS); /* Generate the default ``\.{\\input
					fwebmac.tx}'' line? */
	line_info FSET(LINE_INFO); // Should \FTANGLE\ print out line info?
	lowercase_tokens FSET(LOWERCASE_TOKENS); // Output lower-case tokens?
	m4 FSET(M4_);
	no_xref FSET(NO); // Should \.{WEAVE} print an index?
	number_dos FSET(NUMBER_DOS);
	nuweb_mode FSET(NUWEB_MODE); // Emulate \.{nuweb}?
	overload_ops FSET(OVERLOAD_OPS); // Is operator overloading allowed?

	params.Point_comments[LN(C)] 
		= params.Point_comments[LN(C_PLUS_PLUS)]
		= params.Point_comments[LN(TEX)]
		= params.Point_comments[LN(LITERAL)] 
		= NO;
	params.Point_comments[LN(FORTRAN)]
		= params.Point_comments[LN(FORTRAN_90)]
		= params.Point_comments[LN(RATFOR)] 
		= params.Point_comments[LN(RATFOR_90)]
		= POINT_COMMENTS;  /* Does \.! signify a Fortran comment? */ 

	prn_contents FSET(PRN_CONTENTS); // Print the table of contents?
	prn_index FSET(PRN_INDEX); // Print the index?
	prn_input_lines FSET(NO); /* Used in |input_ln| to print out the
lines sent back. */
	prn_input_addresses FSET(NO); /* Print out the buffer addresses. */
	prn_modules FSET(PRN_MODULES); // Print the module list?
	prn_semis FSET(NO); // Print semicolons in \Fortran\ output.

	Ratfor77 FSET(RATFOR77); /* Expand \Ratfor\ code directly to
\Fortran-77? */  
	params.Reverse_indices[LN(C)]
		= params.Reverse_indices[LN(C_PLUS_PLUS)]
		= params.Reverse_indices[LN(TEX)]
		= params.Reverse_indices[LN(LITERAL)]
		= NO;
	params.Reverse_indices[LN(FORTRAN)]
		= params.Reverse_indices[LN(FORTRAN_90)]
		= params.Reverse_indices[LN(RATFOR)]
		= params.Reverse_indices[LN(RATFOR_90)]
		= REVERSE_INDICES; // C-style indexing in \Fortran?

	skip_includes FSET(SKIP_INCLUDES); /* For \.{WEAVE}, don't read in \.{@@I}
					commands. (Uppercase '\.{I}' only.) */
	statistics FSET(STATISTICS); /* Print statistics about memory usage? */
	stop_the_scan FSET(YES); /* */
	subscript_fcns FSET(YES); // Module references on functions?
	suppress_cmds FSET(YES); /* ??? */
	toggle_includes FSET(TOGGLE_INCLUDES); /* For \.{WEAVE}, read in
\.{@@I} commands, but don't print them out. */
	top_version FSET(TOP_VERSION); /* Header info at top of output? */
	translate_ASCII FSET(TRANSLATE_ASCII0); /* Do we bother with the
|xchr|--|xord| conversions? */
	translate_brackets FSET(TRANSLATE_BRACKETS); /* Do we translate
brackets to parentheses in \Fortran? */
	truncate_ids FSET(NO); /* Shorten identifiers? */
	try_extensions FSET(TRY_EXTENSIONS); // Try various file names.
	TeX_processor FSET(TEX_PROCESSOR); // Default \TeX\ processor.
#undef FSET

#if(TRANSLATE_ASCII || DEBUG_XCHR)
	translate_ASCII = YES;  // Force it for the cases that really need it.
#endif

/* The following ensures that |ini_language| will work right.  (It
references |global_params|. */
global_params = params;
}

@ When we're scanning for identifiers, we have sometimes to do a
byte-by-byte comparison looking for special strings. These have to be
|ASCII|, not ordinary compiler strings. Thus, we initialize them here.

@<Common...@>=

ASCII HUGE *pformat,HUGE *pdefault, HUGE *pdata,
	HUGE *pbp, HUGE *pinclude, HUGE *pcontains;

@ We must translate the |outer_char| strings into |ASCII|.

@<Initialize static...@>=

pformat = x__to_ASCII(OC("format"));
pdata = x__to_ASCII(OC("data"));
pdefault = x__to_ASCII(OC("default"));
pbp = x__to_ASCII(OC("_BP"));
pinclude = x__to_ASCII(OC("include"));

conv_bi(incl_likes);
conv_bi(WEB_incl_likes);
conv_bi(non_labels);

conv_dot(dots0);
conv_dot(mcmds);


@* COMMAND-LINE ARGUMENTS.
The user calls \.{WEAVE} and \.{TANGLE} with arguments on the command line.
These are either file names or flags (beginning with |'-'|).
The following globals are for communicating the user's desires to the rest
of the program. The various file name variables contain strings with
the names of those files.

See the user manual for a detailed description of the various flags.


@<Common...@>=

/* Default file extensions (see \.{os.hweb}) */
@#if 0
char HUGE *C_ext = C_EXT; // |C|
char HUGE *Cpp_ext = Cpp_EXT; // |C_PLUS_PLUS|

char HUGE *R_ext = R_EXT; // |RATFOR|
char HUGE *R90_ext = R90_EXT; // |RATFOR_90|

char HUGE *N_ext = N_EXT; // |FORTRAN|
char HUGE *N90_ext = N90_EXT; // |FORTRAN_90|

char HUGE *M_ext = M_EXT; // |LITERAL|
char HUGE *X_ext = X_EXT; // |TEX|
@#endif

outer_char outp_buf[MAX_OUTPUT_LINE_LENGTH];	// FORTRAN's output buffer.
int nbuf_length = 72;

outer_char wbprefix[MAX_FILE_NAME_LENGTH]; /* Possible directory prefix for
					the web file name. */

 /* Signifies the end of a directory prefix. */
outer_char prefix_end_char = PREFIX_END_CHAR;

boolean all_std = NO; /* Do we route all output to |stdout|? */

@ We now must look at the command line arguments and set the file names
accordingly.  At least one file name must be present: the \.{WEB}
file.  It may have an extension, or it may omit it to get |'.web'|
added.  The \TeX\ output file name is formed by replacing the \.{WEB}
file name extension by |'.tex'|, and the code output file name by replacing
the extension by~|'.c'|, |'.rat'|, or~|'.for'|.

If there is another file name present among the arguments, it is the
change file, again either with an extension or without one to get~|'.ch'|
An omitted change file argument means that \.{/dev/null} (for Unix),
\.{nl:} (for VMS), or \.{NUL} (for DOS) should be used, when no
changes are desired.  (These default extensions are in the style file, and
can be overridden.)
@^system dependencies@>

The following function should be superceded by ANSI's |strchr|.
@<Unused@>=

char HUGE *index FCN((s,c)) /* this is standard, but the name is not */
	char HUGE *s C0("String to be searched.")@;
	char c C1("Search for this character.")@;
{
  while (*s!=c && *s!='\0')
    s++;
  if (*s=='\0') return NULL;
  return s;
}

@*1 Scanning command-line arguments.
Here is the major routine that handles
the command-line arguments. If a command-line option doesn't begin with a
hyphen, it's a file name. If it just a hyphen, it means ``\.{stdin}''.
Otherwise, it's an option.

@<Glob...@>=

boolean found_web,found_change; // Have these names been seen?
outer_char wbflnm0[MAX_FILE_NAME_LENGTH]; // The root name of the web file.

@
@a
SRTN scan_args(VOID)
{
outer_char wbflnm[MAX_FILE_NAME_LENGTH];

/* Build the command line in a buffer. */
cmd_ln_buf = cmd_line(argc,argv);

/* Add the arguments from the ini file \.{.fweb}. This resets |argc| and
|argv|, and also ignores |argv[0]| from the command line. */
set_args(&argc,&argv);

/* Process all the arguments in order from left to right. */
do_args(YES,argc,argv,&found_web,wbflnm,&found_change);

if(statistics) mem_avail(0); /* How much memory is available at start? */

@<Get the path and root file name@>@;

@<Read the style file@>@;

@<Make |web_file_name|, |tex_fname| and output file names@>;

  if (!(found_web || info_option)) usage("!! Missing webfile name.\n");
  if (!found_change) *change_file_name = '\0'; // This means null file.

read_aux(); // Process the \.{.aux} file.
}

@ Here we allocate a buffer and build the command line into it.

@d WEAVE_LINE0 OC("{\"")
@d TANGLE_LINE0 OC("  COMMAND LINE: \"")

@d WEAVE_LINE1 OC("\"} ")
@d TANGLE_LINE1 OC("\"")

@d ESCAPE_LENGTH 256

@<Function...@>=

outer_char HUGE *cmd_line FCN((num_args,args))
	int num_args C0("Number of arguments on command line.")@;
	outer_char *args[] C1("Array of pointers to arguments.")@;
{
int k,len,l0,l1;
outer_char HUGE *buf,HUGE *b, HUGE *line0, HUGE *line1;
outer_char p[ESCAPE_LENGTH]; /* The escaped argument. */

if(program==tangle)
	{
	line0 = TANGLE_LINE0;
	line1 = TANGLE_LINE1;
	}
else
	{
	line0 = WEAVE_LINE0;
	line1 = WEAVE_LINE1;
	}

/* Determine required buffer length. */
for(k=0,len=0; k<num_args; len += STRLEN(args[k++]) + 1) ;

l0 = STRLEN(line0);
l1 = STRLEN(line1);
buf = GET_MEM("buf",2*(len+l0+l1),outer_char);
STRCPY(buf,line0);
b = buf + l0;

while(num_args-- > 0)
	{
	int n = esc_file_name(p,ESCAPE_LENGTH,*(args++));

	STRNCPY(b,p,n);
	b += n;
	*b++ = ' ';
	}

STRCPY(--b,line1); /* Kill off final blank. */
return buf;
}

@*1 Processing {\tt .fweb}. 
Here we handle the initialization file
\.{.fweb}. If it exists, it is opened. Arguments beginning with a '\.+' are
placed before the command-line arguments; those beginning with a '\.-' are
placed after the command-line arguments.

@<Func...@>=

#define MAX_INI_ARGS 100 /* Max \# of arguments in the ini file. */
#define T_SIZE 200 /* Buffer length for |fgets|. */
#define INI_CMNT_CHAR '%'

outer_char HUGE *ini_args[MAX_INI_ARGS], // Arguments read from the ini file.
	HUGE * HUGE *new_args, /* The new list of all arguments; allocated
dynamically. */
	HUGE * HUGE *pn; /* Pointer to the current new argument being
processed. */ 
FILE *ini_file = NULL; /* The ini file \.{.fweb}. */

SRTN set_args FCN((pargc,pargv))
	int HUGE *pargc C0("Pointer to the arg count; new value returned.")@;
    outer_char HUGE * HUGE * *pargv C1("Ptr to the array of ptrs; returned.")@;
{
int k,n;
outer_char HUGE *buffer, HUGE *b, /* Put one line from ini file into here. */
	HUGE *temp, HUGE *t, /* Extract the argument into here. */
	HUGE * HUGE *a, /* The current ini arg. */
	HUGE *pc; /* Pointer to possible comment character in ini line. */
boolean blank;

/* Allocate temporary buffers. */
buffer = GET_MEM("buffer",T_SIZE,outer_char);
temp = GET_MEM("temp",T_SIZE,outer_char);

/* We start by assuming there is no ini file, hence no argument. */
k = 0;

@<Make ini file name and try to open it@>@;

/* If there is an ini file, then put the arguments into an array. */
if(ini_file)
  {
  for(a=ini_args; k<MAX_INI_ARGS; )
	{
	if(FGETS(buffer,T_SIZE,ini_file)==NULL) break; /* Read one line
		(including newline). */

/* Extract the string, disgarding the newline. If the line is blank, do
nothing. */  
	blank = YES;
	for(t=temp,b=buffer; *b; )
		{
		if(*b == '\n') break;
		if(!isspace(*b)) blank = NO;
		*t++ = *b++;
		}
	*t = '\0';

	if(blank) continue;

/* Kill off any trailing comment. */
	if((pc=OC(STRCHR(temp,INI_CMNT_CHAR))) != NULL) TERMINATE(pc,0);
	if(pc==temp) continue; /* The line was entirely a comment. */

	*a = GET_MEM("ini arg",STRLEN(temp)+1,outer_char); /* Space for the
argument. */ 
	STRCPY(*a++,temp); /* Store ini argument. */
	k++;
	}

  FCLOSE(ini_file);
  }

/* Allocate space for all the arguments, both ini and command-line. (We
don't count |argv[0]| from command line.) */
pn = new_args = GET_MEM("new_args",n=*pargc-1+k,outer_char HUGE *);

acopy('+',ini_args,k); /* Put those starting with '\.+' first. */
acopy('0',(outer_char HUGE **)(*pargv),*pargc); /* Then the command-line
						arguments. */ 
acopy('-',ini_args,k); /* Then the rest. */

/* Return the new number and array of arguments. */
*pargc = n;
*pargv = new_args;

FREE_MEM(buffer,"buffer",T_SIZE,char);
FREE_MEM(temp,"temp",T_SIZE,char);
}

@ We will look for the ini file in the user's root directory, if possible.
We determine this by querying the environment with |getenv|.

@d HOME OC("HOME") // The Unix-standard name for the top-level directory.
@d ENV_INI OC("FWEB_INI") // Default root name to use.
@d ENV_INCLUDES OC("FWEB_INCLUDES") // The include path.

@<Make ini file...@>=
@{
outer_char ini_file_name[MAX_FILE_NAME_LENGTH];
outer_char *incl_list,*p_root, ini_root[MAX_FILE_NAME_LENGTH];

#if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
	if( (p_root=GETENV(ENV_INI)) == NULL) STRCPY(ini_root,OC(FWEB_INI));
	else STRCPY(ini_root,p_root);

	incl_list = GETENV(ENV_INCLUDES);
	if(incl_list) more_includes(incl_list);
#else
	STRCPY(ini_root,OC(FWEB_INI));
#endif // |HAVE_GETENV|

ini_file = FOPEN(mk_fname(ini_file_name,MAX_FILE_NAME_LENGTH,
		HOME,YES,ini_root),"r");
}

@ The list of include paths is allocated only as necessary.
@<Glob...@>=

struct
	{
	unsigned size; // Length of |list|.
	outer_char HUGE *list; // List of include files.
	} incl = {0,NULL};

@ This functions adds more entries to the include list.  The list is
constructed in the format \.{$\alpha$:$\beta$:$\gamma$:}; in other words,
entries are terminated by a colon.

@<Func...@>=
SRTN more_includes FCN((incl_list0))
	outer_char *incl_list0 C1("")@;
{
unsigned n;

/* Strip off useless opening colon. */
while(*incl_list0 == ':') incl_list0++;

if((n = STRLEN(incl_list0)) == 0) return;

incl.size += n + 2; // Allow for trailing colon and null byte.

if(!incl.list) 
	{ /* List hasn't been allocated yet. */
	incl.list = GET_MEM("incl_list",incl.size,outer_char);
	STRCPY(incl.list,incl_list0);
	}
else 
	{ /* Add more to the list. */
	incl.list = (outer_char HUGE *)REALLOC(incl.list,incl.size);

	if(incl.list == NULL)
		FATAL("!! No more memory (more_includes)","");

	STRCAT(incl.list,incl_list0);
	}

/* Ensure list ends in a colon. */
if(incl.list[n-1] != ':') incl.list[n] = ':';
}	

@
@<Func...@>=
char *mk_fname FCN((buffer,buf_len,env_var,print_msg,file_name))
	outer_char *buffer C0("Put result here.")@;
	unsigned buf_len C0("Length of |buffer|.")@;
	CONST outer_char *env_var C0("Variable that holds directory name.")@;
	boolean print_msg C0("Flag for not recognizing |env_var|.")@;
	CONST outer_char *file_name C1("The raw file name.")@;
{
outer_char *directory; // Will hold result of |getenv|. 

#if HAVE_GETENV /* \.{Machine-dependent}: Understands |getenv|. */
	if( (directory=GETENV(env_var)) == NULL) 
		{
		if(print_msg)
		  printf("! I can't find environment \
variable \"%s\", so I'll look for file \"%s\" \
in directory \"%s\".\n",
			env_var,file_name,
				*wbprefix ? wbprefix : OC("."));
		if(buf_chk(file_name,buf_len,
				STRLEN(file_name)+STRLEN(wbprefix)))
			return (char *)wt_style.null_file_name;
		STRCPY(buffer,wbprefix);
		STRCAT(buffer,file_name);
		}
	else
		{ /* Got a directory from the environment variable. */
		if(buf_chk(file_name,buf_len,
			STRLEN(directory)+1+STRLEN(file_name)))
				return (char *)wt_style.null_file_name;
/* For Unix, home is of the form
\.{/u/krommes}; for VMS, it's like \.{ux3:[krommes]}. */
   #if !UNIX_PATH
	SPRINTF(buf_len,buffer,`"%s%s",directory,file_name`);
   #else
	SPRINTF(buf_len,buffer,`"%s%c%s",directory,prefix_end_char,file_name`);
   #endif // |!UNIX_PATH|
		}
#else /* Doesn't understand |getenv|. */
	if(buf_chk(file_name,buf_len,STRLEN(file_name))) 
		return (char *)wt_style.null_file_name; 
	STRCPY(buffer,file_name);
#endif // |CAN_GETENV|

return (char *)buffer;
}

@ Make sure we don't overrun a file buffer.
@<Func...@>=

boolean buf_chk FCN((file_name,buf_len,needed))
	CONST outer_char *file_name C0("Raw file name")@;
	unsigned buf_len C0("Max space available")@;
	unsigned needed C1("Requested")@;
{
if(needed >= buf_len)
	{
	printf("\n! Buffer too small to make complete file name from \
\"%s\"; opened \"%s\"\n",file_name,wt_style.null_file_name);
	return YES;
	}

return NO;
}

@ Here we copy from an old argument array to the new one. If the argument
begins with a~'\.+', that is changed to a~'\.-'.
@<Func...@>=

SRTN acopy FCN((c,a,n))
	outer_char c C0("Starting symbol.")@;
	outer_char HUGE **a C0("Old array.")@;
	int n C1("Number of arguments to be looked at.")@;
{
boolean is_plus = BOOLEAN(c=='+');
boolean is_minus = BOOLEAN(c=='-');
int k;

/* Disgard the zeroth argument from the command line. */
if(c=='0')
	{
	k = 1;
	a++;
	}
else k = 0;

/* Look at all the arguments; copy them if appropriate. */
for(; k<n; k++,a++)
	if( ((!is_plus) && (*a)[0]!='+') || (!is_minus && (*a)[0]=='+'))
		{
		*pn = GET_MEM("*pn",STRLEN(*a)+1,outer_char);
		STRCPY(*pn,*a);
		if((*pn)[0] == '+') (*pn)[0] = '-';
		pn++;
		}
}

@*1 Making file names.
We use all of |pa=*argv| for the |web_file_name| if
there is a~|'.'| in it, otherwise add |'.web'|. \It{This has to be
augmented for VMS!} The other file names come from adding things after the
dot.  We must check that there is enough room in |web_file_name| and the
other arrays for the argument.

If the output file name was already set by~`\.{->}', we do nothing, except if
it contains a~`\.\#' we expand that into the |wbflnm0|.  If it was not set,
we add the extension determined from the style file.

@m SET_NAME(l,labbrev) set_name(l,wt_style.output_ext.labbrev##_)

@<Make |web_file_name...@>=
{
int k;

/* \WEAVE's output file. */
xpn_name(&tex_fname,MAX_FILE_NAME_LENGTH,tex_fname,wbflnm0);
if(*tex_fname == '\0') new_fname(&tex_fname,wbflnm0,OC("tex"));

/* \TANGLE's output files. */
for(k=0; k<NUM_LANGUAGES; k++)
	xpn_name(params.outp_nm+k,MAX_FILE_NAME_LENGTH,
		params.outp_nm[k],wbflnm0);
	
SET_NAME(C,C);
SET_NAME(C_PLUS_PLUS,Cpp);
SET_NAME(LITERAL,V);
SET_NAME(FORTRAN,N);
SET_NAME(FORTRAN_90,N90);
SET_NAME(RATFOR,R);
SET_NAME(RATFOR_90,R90);
SET_NAME(TEX,X);
}

@
@<Get the path...@>=
{
outer_char HUGE *dot_pos;
outer_char HUGE *p = NULL;

if (STRLEN(wbflnm) > MAX_FILE_NAME_LENGTH-5)
	too_long();

if(STRCMP(wbflnm,"stdin") == 0) STRCPY(web_file_name,wbflnm);
else 
	{
	p = OC(STRRCHR(wbflnm,prefix_end_char)); // Is there a path?

	if((dot_pos=OC(STRCHR(p ? p+1 : wbflnm,wt_style.ext_delimiter)))==NULL
			 && !try_extensions)
		{ /* Attach ``\.{.web}'' as a default. */
		SPRINTF(MAX_FILE_NAME_LENGTH,web_file_name,`"%s%cweb",
			wbflnm,wt_style.ext_delimiter`);
		}
	  else { /* There's a dot, or we're trying extensions; treat the
name as is. */ 
		SPRINTF(MAX_FILE_NAME_LENGTH,web_file_name,`"%s",wbflnm`);

		if(!try_extensions)
			TERMINATE(dot_pos,0); /* string now ends where the
dot was */ 
		}
	}

@<Extract the basic file name and the directory prefix@>@;
}

@
@a
SRTN set_name FCN((l,output_ext))
	LANGUAGE l C0("")@;
	outer_char *output_ext C1("")@;
{
int k;		

if(*params.outp_nm[k=lan_num(l)] == '\0')
	new_fname(params.outp_nm+k,wbflnm0,output_ext);
}

@ We will always write into the current directory. Thus, we strip off all
leading subdirectory information.
@<Extract...@>=
{
if(p)
	{ /* Path was specified. */
	STRNCPY(wbprefix,wbflnm,
		PTR_DIFF(size_t,p,(outer_char HUGE *)wbflnm)+1); // Path.
	STRCPY(wbflnm0,p+1); // Root name.
	}
else
	{ /* No path specification. */
	TERMINATE(wbprefix,0); // No path.
	STRCPY(wbflnm0,wbflnm); // Root name.
	}
}

@ Here we search for an embedded~`\.\#' and expand that into the web file
name.
@<Func...@>=

outer_char HUGE *xpn_name FCN((pout_name,buf_len,in_name,wbflnm0))
	outer_char HUGE * HUGE *pout_name C0("The expanded result")@;
	int buf_len C0("Length of above buffer")@;
	CONST outer_char *in_name C0("File name possibly having a \.\#.")@; 
	CONST outer_char wbflnm0[] C1("Basic name of the web file.")@;
{
size_t n; /* Length of the root name. */
outer_char HUGE *t,HUGE *t0=NULL;
boolean buffered = BOOLEAN(*pout_name == in_name);

if(buffered) t = t0 = GET_MEM("xpn buffer",buf_len,outer_char);
else t = *pout_name;

for(; *in_name; in_name++)
	if(*in_name == '#')
		{
		n = STRLEN(wbflnm0);
		STRNCPY(t,wbflnm0,n);
		t += n;
		}
	else *t++ = *in_name;

TERMINATE(t,0);

if(buffered)
	{
	new_fname(pout_name,t0,NULL);
	FREE_MEM(t0,"xpn buffer",buf_len,outer_char);
	}

return *pout_name;
}


@*1 Processing the {\tt .aux} file.
When |TeX_processor == LaTeX_p|, the \.{.aux} file is read if it is
present.  Information from the \.{\\Newlabel} commands is accumulated and
used to translate module numbers in error messages.

@d AUX_LEN 200
@d MAX_MOD_NAMES 3 // No more than this many names in one error message.

@<Typed...@>=

typedef struct
	{
	outer_char *secno; // The \LaTeX\ section number.
	sixteen_bits pageno, modno0;
	boolean subpage_flag; // |YES| if more than one section per page.
	} SECT_INFO;

SECT_INFO sect_info[100]; // !!!!! MUst allocate dynamically.

outer_char HUGE * HUGE *mod_names;
outer_char  HUGE * HUGE *next_mod_name, HUGE * HUGE *last_mod_name;

@ Open the \.{.aux} file, read and process each line of the file.  If the
line begins with ``\.{\\Newlabel}'', then the line is parsed.  The same
logic as in \.{fwebmac.web} is used to set the |subpage_flag| to |NO| if
there is only one section per page, or to |YES| if there are more than one.

@a
SRTN read_aux(VOID)
{
outer_char aux_file_name[MAX_FILE_NAME_LENGTH];
FILE *fa;
outer_char buffer[AUX_LEN];
int aline = 0; // Counts line in the \.{.aux} file.
sixteen_bits modno, modno0;
outer_char smodno[10], smodno0[10], spageno[10], ssecno[100];
int n;
SECT_INFO *ps; // Points to current info structure.
int pmcount = 1; // Number of sections per page.
long modno_ref = -1; /* Last reference module number.  It's |long| to deal
	with the possibility of 16-bit integers, where |-1| would be the
	maximum module number. */

next_mod_name = mod_names = GET_MEM("mod_names", MAX_MOD_NAMES, 
	outer_char HUGE *@e); 
last_mod_name = mod_names + MAX_MOD_NAMES;

if(TeX_processor != LaTeX_p) return;

@<Determine \.{aux} file name and try to open it@>@;

modno = 0; // In case there's nothing in the \.{.aux} file.

while(FGETS(buffer,AUX_LEN,fa))
	{
	aline++;

	if(STRNCMP(buffer,"\\Newlabel",9) != 0) continue;

	@<Parse a \.{\\Newlabel} line@>@;
	}

sect_info[modno].subpage_flag = BOOLEAN(pmcount != 1);
}

@
@<Determine \.{aux}...@>=
{
outer_char *dot_pos; // For finding extension in file name.

dot_pos = OC(STRCHR(tex_fname, wt_style.ext_delimiter));

if(dot_pos == NULL)
	n = STRLEN(tex_fname);
else
	n = dot_pos - tex_fname;

STRNCPY(aux_file_name, tex_fname, n);
SPRINTF(MAX_FILE_NAME_LENGTH, aux_file_name+n,`"%caux", 
	wt_style.ext_delimiter`);

fa = FOPEN(aux_file_name, "r");

if(!fa)
	{
	printf("(No %s file.)\n", aux_file_name);
	return;
	}
else
	reading(aux_file_name, YES);

}

@ The format of the \.{\\Newlabel} line is
``\.{\\Newlabel\{12\}\{\{1.11\}\{5\}\}\{10\}}''.  We use the ANSI |sscanf|
\.{\%[\dots]} format command to read the contents of the braces as strings.

@<Parse a \.{\\New...@>=
{
#if(!ANSI_SSCANF)
	{
	ERR_PRINT(C,"Sorry, non-ANSI sscanf; can't read .aux file");
	return;
	}
#endif

n = sscanf((char *)(buffer+9),"%*c%[^}]%*3c%[^}]%*2c%[^}]%*3c%[^}]",
	   smodno, ssecno, spageno, smodno0);

if(n != 4)
	{
	err_print(C,"Invalid \\Newlabel format in %s file, line %d",
		aux_file_name, aline);
	return;
	}

modno = ATOI(smodno);

ps = sect_info + modno;

ps->secno = GET_MEM("ps->secno",STRLEN(ssecno)+1,outer_char);
STRCPY(ps->secno, ssecno);

ps->pageno = ATOI(spageno);
ps->modno0 = modno0 = ATOI(smodno0);

/* Check to see whether there was more than one section on a page.  */
sect_info[modno-1].subpage_flag = YES;

if((long)modno0 == modno_ref)
      pmcount++; // More than one section on page.
else
      { /* Start of new page. */
	if(pmcount == 1)
	  sect_info[modno-1].subpage_flag = NO;
	
	modno_ref = (long)modno0;
	pmcount = 1;
      }
}

@ Format a module number including section and page information.  (The
value returned from this function should be |FREE|d after use by calling
|mfree|.) 

@d NMOD_TEMP 200

@a
outer_char HUGE *mod_trans FCN((prefix,modno))
	outer_char *prefix C0("")@;
	sixteen_bits modno C1("")@;
{
outer_char HUGE *mod_temp = GET_MEM("mod_temp", NMOD_TEMP, outer_char);
SECT_INFO *ps = sect_info + modno;

if(ps->secno)
	SPRINTF(NMOD_TEMP, mod_temp, `"%s %d (sect. %s, p. %d%c)",
		prefix, modno, ps->secno, ps->pageno,
		ps->subpage_flag ? XCHR(modno - ps->modno0 + @'a' - 1) : ' '`);
else
	SPRINTF(NMOD_TEMP, mod_temp, `"%s %d", prefix, modno`);

if(next_mod_name == last_mod_name)
	CONFUSION("mod_trans","too many unfreed mod names");

return *(next_mod_name++) = mod_temp;
}

@ Undo storage areas allocated for |mod_trans|.
@a
SRTN mfree(VOID)
{
if(!mod_names) return; // For errors happening during the command line.

for(--next_mod_name; next_mod_name >= mod_names; next_mod_name--)
	FREE(*next_mod_name);
}

@*1 Indexing languages.
Languages have both a number, name, and symbol; be
careful to keep these all in the same order. We provide two functions:
|lan_num| takes a language and returns an index number; |lan_enum| takes an
index number and returns a language.

@<Func...@>=

int lan_num FCN((Language))
	LANGUAGE Language C1("")@;
{
proper_language:
  switch(Language)
	{
	case C: 	return 0;
	case RATFOR: 	return 1;
	case FORTRAN: 	return 2;
	case TEX: 	return 3;
	case LITERAL: 	return 4;

	case C_PLUS_PLUS: return 5;
	case RATFOR_90: return 6;
	case FORTRAN_90: return 7;

	case NO_LANGUAGE: Language = GLOBAL_LANGUAGE; goto proper_language;
	default: Language = global_language; goto proper_language;
	}
}

LANGUAGE lan_enum FCN((num))
	int num C1("Integer index of the language.")@;
{
switch(num)
	{
	case 0: return C;
	case 1: return RATFOR;
	case 2: return FORTRAN;
	case 3: return TEX;
	case 4: return LITERAL;

	case 5: return C_PLUS_PLUS;
	case 6: return RATFOR_90;
	case 7: return FORTRAN_90;

	default: return NO_LANGUAGE;
	}
}

@ The function |lan_index| is like |lan_num|, but it compresses
|RATFOR| and |FORTRAN| onto the same index.

@a
int lan_index FCN((Language))
	LANGUAGE Language C1("")@;
{
proper_language:
  switch(Language)
	{
	case C: 	return 0;

	case RATFOR: 
	case FORTRAN: 	return 1;

	case TEX: 	return 2;
	case LITERAL: 	return 3;

	case C_PLUS_PLUS: return 4;

	case RATFOR_90:
	case FORTRAN_90: return 5;

	case NO_LANGUAGE: Language = GLOBAL_LANGUAGE; goto proper_language;
	default: Language = global_language; goto proper_language;
	}
}

@*1 Processing {\tt fweb.sty}. 
Here we construct the name of the style file, and read that file.

@%@d STYLE_FILE_NAME "fweb.sty"

@<Glob...@>=

outer_char style_file_name[MAX_FILE_NAME_LENGTH] = STYLE_FILE_NAME;
static boolean renamed_style = NO;

@
@<Read the style file@>=
{
read_sty(style_file_name,renamed_style); // See \.{style.web}.

@<Convert selected fields to |ASCII|@>@;
}

@ The style file is read as |outer_char|.  Some fields are best left that
way, while others need to be converted to |ASCII|.

@<Convert selected...@>=
{
DOT_DELIMITER HUGE *d = &wt_style.dot_delimiter;

d->begin = XORD(d->begin);
d->end = XORD(d->end);

if(program==tangle)
	{
	t_style.ASCII_fcn = x__to_ASCII((outer_char *)t_style.ASCII_fcn);
	}
}

@*1 Processing command-line arguments.
Processing arguments is done in a
separate function because it's called several times: once for the command
line, and (possibly) each time there's a language change.

@d THE_FILE_NAME (a_file_name ? pa : (outer_char HUGE *)"stdin")

@<Glob...@>=

static boolean doing_cmd_line;

@
@a
SRTN do_args FCN((doing_cmd_line0,argc,argv,pfound_web,wbflnm,pfound_change))
	boolean doing_cmd_line0 C0("")@;
	int argc C0("")@;
	outer_char HUGE *argv[] C0("")@;
	boolean HUGE *pfound_web C0("")@;
	outer_char wbflnm[] C0("")@;
	boolean HUGE *pfound_change C1("")@;
{
boolean a_file_name; // Is an actual file name supplied from the command line?
outer_char HUGE *dot_pos; /* Position of |'.'| (or more generally,
			|wt_style.ext_delimiter|) in the argument */

doing_cmd_line = doing_cmd_line0;

*pfound_web = *pfound_change = NO;

while (argc-- > 0) 
    {
    pa = *(argv++); /* Beginning of current argument string. */

/* Arguments that don't begin with a hyphen, or that are just a single
hyphen with no trailing stuff, mean file names. */
    if ( (a_file_name= BOOLEAN(*pa != '-')) || *(pa+1)=='\0') 
	@<Process a file name@>@;
    else 
	@<Handle flag argument@>;
    }
}

@
@<Process a file name@>=
{
if(doing_cmd_line)
	{
        if (!*pfound_web) 
		{
		STRCPY(wbflnm,THE_FILE_NAME);
		*pfound_web = YES;
		}
        else if (!*pfound_change) 
		@<Make |change_file_name| from |fname|@>@;
        else 
		@<Print change file warning message and |continue|@>;
	}
else 
	{}
}     

@ 
@<Make |change_file_name|...@>=
{
  if (a_file_name && STRLEN(pa) > MAX_FILE_NAME_LENGTH-5)
	too_long();

/* For VMS, should skip over brackets here. */

  if (a_file_name && (dot_pos=OC(STRCHR(pa,wt_style.ext_delimiter)))==NULL
		 && !try_extensions)
	{
	SPRINTF(MAX_FILE_NAME_LENGTH,change_file_name,`"%s%cch",
		pa,wt_style.ext_delimiter`);
	}
  else 
	{
	SPRINTF(MAX_FILE_NAME_LENGTH,change_file_name,`"%s",THE_FILE_NAME`);
	}

  *pfound_change=YES;
}

@ After a language command, there may be optional arguments that must also
be parsed.  

@d ARG_BUFFER_SIZE 500
@d COPY_TO_ARG_BUFFER(c) if(pa < arg_buffer_end) *pa++ = c;
			else OVERFLW("arg buffer bytes","")@;
@d MAX_ARGS 100

@a
SRTN opt_args FCN((l))
	ASCII l C1("")@;
{
ASCII arg_buffer[ARG_BUFFER_SIZE],*pa = arg_buffer,
	*arg_buffer_end = arg_buffer + ARG_BUFFER_SIZE;
int argc;
outer_char HUGE *args[MAX_ARGS];

ini_language(l); /* Set language and initialize flags. */ 

if(!IS_WHITE(*loc))
{
if(*loc != @'[')
	{ /* Unbracketed command, as in \.{@@c++}. */
	*pa++ = @'-'; 	// Make it an honest command.
	*pa++ = l;	// Don't forget the language.

	WHILE()
		{
		if(IS_WHITE(*loc) || *loc==@'[') break;
		if(*loc==@'|' && parsing_mode==INNER)
			{
			ERR_PRINT(C,"WARNING:  Code mode ended during \
unbracketed optional argument.  Should there be white space after \
language command?");
			break;
			}
		COPY_TO_ARG_BUFFER(*loc++);
		}
	}

/* We allow bracketed commands to follow unbracketed ones. */
if(*loc == @'[')
	{
	COPY_TO_ARG_BUFFER(@' ');

	for(loc++; ; )
		{ // Skip the opening bracket; copy contents.
		if(*loc == @']') 
			{
			loc++; /* Skip the ending bracket. */
			break;
			}
		COPY_TO_ARG_BUFFER(*loc++);
		}
	}	

TERMINATE(pa,0); /* Terminate |arg_buffer|. */
argc = to_args(to_outer(arg_buffer),args,MAX_ARGS);
do_args(NO,argc,args,&found_web,(outer_char *)NULL,&found_change);
if(found_web || found_change) {}
}

fin_language(); /* Do any further flag setup. */
}

@ Set the language, and also set up flags for particular language.
The input parameter is the letter corresponding to the basic language.
Subsidiary dialect flags such as~|Cpp| or~|Fortran88| are used to determine
the full language.
@a
SRTN ini_language FCN((l))
	ASCII l C1("Basic language code")@;
{
/* First we set the language. */
switch(l)
	{
   @<|ASCII| cases for |C|@>:
	language = (Cpp ? C_PLUS_PLUS : C);
	break;

   @<|ASCII| cases for |RATFOR|@>:
	if(!RAT_OK("Invalid @@r command; language set to C")) language = C;
	else language = (Fortran88 ? RATFOR_90 : RATFOR);
	break;

   @<|ASCII| cases for |FORTRAN|@>:
	language = (Fortran88 ? FORTRAN_90 : FORTRAN);
	break;

   @<|ASCII| cases for |LITERAL|@>:
	language = LITERAL;
	break;

   @<|ASCII| cases for |TEX|@>:
	language = TEX;
	break;
	}

/* The following is for checking an override of the command-line language
in the limbo section. */
if(doing_cmd_line) cmd_language = language;

ini0_language();
}

@ Set parameters for each language. Note that certain flags, such as
|free_form_input|, are really arrays that can have a different value
depending on the language.

@a
SRTN ini0_language(VOID)
{
/* Set the output language. */
out_language = OUT_LANGUAGE(language);

/* Storing these numbers cuts down on the overhead of function calls.  It
also enables us to use the macros in the following |switch| properly. */
language_index = lan_index(language); // Maybe no longer used.
language_num = lan_num(language);

index_flag = YES; // Most languages will cross-reference.

switch(language)
	{
   case C:
	Cpp = NO;
	break;

   case C_PLUS_PLUS:
	Cpp = YES; // Just a shorthand for |language==CPP|.
	break;

   case FORTRAN:
   case FORTRAN_90:
	free_form_input = global_params.Free_form_input[language_num];
/* This can be turned on by the \.{-n\\} or \.{-n\&} options. */
	auto_semi = global_params.Auto_semi[language_num];
	break;	

   case RATFOR:
   case RATFOR_90:
	if(nuweb_mode)
		err_print(C, "SORRY, but Ratfor doesn't work yet with the N \
mode!") ;
	auto_semi = global_params.Auto_semi[language_num];
	if(auto_semi) free_form_input = NO;
	break;

   case LITERAL:
	nuweb_mode = YES;
	line_info = NO;
	index_flag = NO;
	break;

   case TEX:
	break;

   default:
	break;
	}
}

@ Now handle any parameter modifications after optional arguments have been
read. 
@a
SRTN fin_language(VOID)
{
ini_reserved(language);

switch(language)
	{
   case C:
	break;

   case RATFOR:
	break;

   case FORTRAN:
	break;

   case LITERAL:
	break;

   case TEX:
	break;

   default:
	break;
	}

frz_params(); // Make any local parameters.

/* Output file name.  For |program == weave|, |out_file == tex_file| by a
macro definition in \.{typedefs.hweb}. */
if(program == tangle)
	out_file = params.outp_file[lan_num(out_language)];
}

@ Call this routine whenever |params| is reset.
@a
SRTN frz_params(VOID)
{
@#if 0
	if(auto_semi && !Fortran88) free_form_input = NO;
@#endif

cont_char = XORD(in_escape); // Current continuation character (in |ASCII|).
free_90 = BOOLEAN(Fortran88 && free_form_input);
free_Fortran = BOOLEAN((language==FORTRAN_90) && free_90);
auto_semi = BOOLEAN(is_FORTRAN_(language) && !free_Fortran);

if(program==tangle && free_90)
	switch(language)
		{
	   case FORTRAN_90:
	   case RATFOR_90:
		begin_comment_char[lan_num(FORTRAN_90)] = 
			(outer_char)CHOICE(free_90,'!','C');
		break;

	   default: ;
		}	
	
}

@ At this point the effective command line is in |outer_char| form in
|arg_buffer|. 
@a 
int to_args FCN((p,args,max_args))
	outer_char HUGE *p C0("")@;
	outer_char HUGE *args[] C0("")@;
	int max_args C1("")@;
{
int n;

for(n=0; *p; p++)
	{
	if(n >= max_args) 
		{
		err_print(C,"Too many command-line or optional \
arguments; must be < %d",max_args);
		break;
		}
	while(isspace(*p)) p++; // Skip leading white space.
	args[n++] = p; // Record start and count.

	for(p++; *p; p++)
		if(isspace(*p) || !*p) break; // Find end of argument.

	if(!*p) break; // Get out at end of line.
	TERMINATE(p,0); // Mark end of argument.
	}

return n; // Number of arguments found.
}

@
@<Initialize static...@>=

SET_VAL(mbuf_size,ABBREV(mbuf_size));

@ These are for automatic statement numbering.

@d STARTING_DO_NUM UL(90000L)

@<Common...@>=

STMT_LBL max_stmt = STARTING_DO_NUM;
int not; /* For the negations of options. */

@ For many of the flags, a minus option, as \.{-flag}, means to do the
opposite of the default.  Furthermore, if the format is \.{--flag}, this is
the opposite of \.{-flag}.  Negating the usual flag value can be
accomplished by exclusive-oring it with |not|, where |not == YES| when we
have the extra hyphen, or |NO|~otherwise.

@d NOT(flag) BOOLEAN((!flag) ^ not)

@<Handle flag...@>=
@{
outer_char mc;
outer_char cmd_symbol; // The character after the hyphen.

@b
pa++; // |pa| now points to the character after the hyphen.

if(*pa == '-')
	{ 	// Second hyphen means negate.
	not = YES;
	pa++; 	// Skip second hyphen.
	}
else 
	not = NO;

reswitch:
  switch(cmd_symbol= *pa++)
	{ /* |pa| now positioned after command symbol---e.g., to optional
argument. */
   case '1':
   case '2':
	tracing = cmd_symbol - '0'; @+ break;

   case '@@':
	@<Option \.{-@@}: print control codes@>@;
	break;

   case 'a':
   case 'A': 
	@<Option \.{-A}: translations to |ASCII|@>@;
	break;

   case 'b':
	@<Option \.{-b}: block numbering@>@;
	break;

   case 'B':
	beeps = NOT(BEEPS);
	break;

   @<|outer_char| cases for |C|@>:
	@<Option \.{-c}:  C and \Cpp@>@;
	break;

   case 'D':
/* We can't immediately execute |see_reserved| because dynamic memory and
the |name_dir| hasn't been set up yet. */
	rsrvd_args = pa;
	info_option = YES;
	break;

   case 'd':
	number_dos = NOT(NUMBER_DOS); // NOTE:  falls through to next case!

   case ':':
	@<Option \.{-:}:  starting line number@>@;
	break;

   case 'e':
	try_extensions = NOT(TRY_EXTENSIONS); @+ break;

   case 'E':
	@<Option \.{-E}:  change extension delimiter@>@;
	break;

   case 'f':
	subscript_fcns = NOT(SUBSCRIPT_FCNS); @+ break;

   case 'F':
	compare_outfiles = NOT(COMPARE_OUTFILES); @+ break;

   case 'g':
	dbg_output = NOT(DBG_OUTPUT); @+ break;

   case 'h':
	@<Issue warning if this command is negated@>@;
	help(); 
	break;

   case 'i':
	if(*pa)
		{
		if(*pa == '!') 
			skip_includes = NOT(SKIP_INCLUDES); 
		else 
			bad_option();
		}
	else 
		toggle_includes = NOT(TOGGLE_INCLUDES); 

	break;

   case 'I':
	more_includes(pa); // Add to include path list.
	break;

   case 'l':
	@<Option \.{-l}:  print input lines for debugging@>@;
	break; 

   case 'L':
	@<Option \.{-L}:  generalized language switch@>@;
	break;

   case 'm':
   case 'M':
	@<Option \.{-m}:  macro definitions etc.@>@;
	break;			

   
   case 'N':
	nuweb_mode = NOT(NUWEB_MODE);
	break;

   case 'n':
	FR_args(FORTRAN);
	break;

   case 'o':
	overload_ops = NOT(OVERLOAD_OPS);
	break;

   case 'p':
	@<Option \.{-p}:  collect style-file parameter@>@;
	break;

   case 'P':
	@<Option \.{-P}:  specify the \TeX\ processor@>@;
	break;

   case 'q':
	free_form_input = NOT(FREE_FORM_INPUT);
	Ratfor77 = NOT(RATFOR77);
	break;

   @<|outer_char| cases for |RATFOR|@>:
	if(!RAT_OK("Language command ignored")) 
		break;
	FR_args(RATFOR);
	break;

   case 's':
	@<Option \.{-s}:  statistics@>@;
	break;

   case 't':
	@<Option \.{-t}:  truncate identifiers@>@;
	break;

   case 'T':
	@<Option \.{-T}:  various flags for \FTANGLE@>@;
	break;

   case 'u':
	@<Option \.{-u}:  undefine a macro@>@;
	break;

   case 'U':
	lowercase_tokens = NOT(LOWERCASE_TOKENS);
	break;

   case 'v':
	all_cmnts_verbatim = NOT(ALL_CMNTS_VERBATIM);
	break;

   case 'w':
	if(*pa)	
		new_fname(&fwebmac,pa,NULL);
	else 
		input_macros = NOT(INPUT_MACROS);

	break;

   case 'W':
	@<Option \.{-W}:  various flags for \FWEAVE@>@;
	break;

   case 'x':
	flags3(BOOLEAN(not));
	break;

   case 'X':
	flags3(BOOLEAN(!not));
	break;
		
   case 'y':
	@<Option \.{-y}:  process allocation command@>@;
	break;

   case 'z':
	@<Option \.{-z}@>@;
	break;

   case 'Z':
	prn_style_defaults = BOOLEAN(!not);
	style_args = pa;
	info_option = YES;
	break;

   case '.':
	dot_constants = NOT(DOT_CONSTANTS);
	break;

   case '\\':
	bslash_continued_strings = NOT(BSLASH_CONTINUED_STRINGS);
	break;

   case '?':
	chk_stmts = NOT(CHK_STMTS); 
	break;

   case '[':
	translate_brackets = NOT(TRANSLATE_BRACKETS); 
	break;

   case '(':
   case ')':
	chk_ifelse = NOT(CHK_IFELSE); @+break;

   case '>':
   case '=':
	@<Issue warning if this command is negated@>@;
	if(doing_cmd_line || phase==2) 
		redirect_output();
	break;

   case '/':
	params.CPP_comments[LN(FORTRAN)] =
params.CPP_comments[LN(RATFOR)] = BOOLEAN(YES ^ not);
	break;

   case '!':
	params.Point_comments[LN(FORTRAN)] =
params.Point_comments[LN(RATFOR)] = BOOLEAN(YES ^ not);
	break;

   case '+':
	compound_assignments = NOT(COMPOUND_ASSIGNMENTS); @+ break;

   case '#':
	line_info = NOT(LINE_INFO); @+ break;

   default: 
	bad_option();
	break;
	}
}


@*1 Option {\tt -@@}.  

@<Option \.{-@@...@>=
{
at_codes = to_ASCII(pa);
info_option = YES;
}

@*1 Option {\tt -A}.
ASCII translations are off by default on |ASCII|
machines; they're turned on for the cases that really need.  Therefore,
this flag is for debugging.

@<Option \.{-A}...@>=
{
#if(TRANSLATE_ASCII || DEBUG_XCHR)
	translate_ASCII = YES;  // Force it for the cases that really need it.
#else
	translate_ASCII = NOT(TRANSLATE_ASCII0); 
#endif
}


@*1 Option {\tt -b}.

@<Option \.{-b}...@>=
{
params.Block_nums[LN(FORTRAN)] = params.Block_nums[LN(RATFOR)] =
	NOT(BLOCK_NUMS); 
}

@*1 Option {\tt -c}.
Options related to the C~language.

@<Option \.{-c}...@>=
{
@<Issue warning if this command is negated@>@;

Cpp = BOOLEAN(*pa == '+'); /* The commands \.{-c+} or \.{-c++} turn on
				knowledge of \.{C++}. */ 
if(Cpp) while(*pa == '+') pa++; // Skip the pluses.

switch(*pa)
	{
   case '{':
	set_filter(Cpp ? C_PLUS_PLUS : C); 
	break;
 
   case '\0':
	ini_language(XORD(*LANGUAGE_CODE(C)));
	break;

   default:
	break;
	}
}


@*1 Options {\tt -d} and {\tt -:}.
Process starting line number.

@<Option \.{-:}...@>=
{
@<Issue warning if this command is negated@>@;

max_stmt = STARTING_DO_NUM;

if(*pa)
	{ // Optional starting line number specified.
	max_stmt = ATOL(pa);

	if(max_stmt > 99999L)
err_print(C,"Starting DO number must be < 99999; assuming %lu",
		max_stmt = STARTING_DO_NUM);
	}
}


@*1 Option {\tt -E}.
Change the extension delimiter from its default value of period.

@<Option \.{-E}...@>=
{
@<Issue warning if this command is negated@>@;

if(*pa)	wt_style.ext_delimiter = *pa;
else err_print(C,"Missing character after -E option; option ignored");
}

@*1 Option {\tt -h}.
Enter the help package with \.{-h}. (But it's not here yet!) 

@a
SRTN help(VOID)
{
puts("! For help, please see the texinfo entry, \
fwebman.tex, or use options\n\ 
 '-D' (query reserved words),\n\
 '-y' (query memory allocations),\n\
 '-Z' (query style-file parameters)."); 

usage(""); // In lieu of anything better.
}


@*1 Option {\tt -l}.
Print input lines for debugging; see |input_ln|.

@<Option \.{-l}...@>=
{
prn_input_lines = BOOLEAN(YES ^ not);

if(*pa) 
	if(isdigit(*pa) || *pa=='-')
		{
		outer_char *colon_pos;

		start_line = ATOL(pa);
		if((colon_pos=OC(STRCHR(pa,':'))) == NULL)
		   end_line = LONG_MAX;
		else end_line = ATOL(colon_pos + 1);
		}
				
	else
		{
		printf("! Option `-l' must be followed by integer.\n");
		mark_harmless;
		}

/* Negative line numbers are undocumented; they're for the developer. */
if(start_line < 0)
	{
	start_line = -start_line;
	prn_input_addresses = YES;
	}
}


@*1 Option {\tt -L}.
Generalized language switch.

@<Option \.{-L}...@>=
{
switch(*pa)
	{
   @<|outer_char| cases for |C|@>:
   @<|outer_char| cases for |FORTRAN|@>:
   @<|outer_char| cases for |RATFOR|@>:
	goto reswitch;

   @<|outer_char| cases for |LITERAL|@>:		  
	@<Issue warning if this command is negated@>@;
	switch(*(pa+1))
		{
	   case '{':
		set_filter(LITERAL);
		break;

	   case '\0':
		ini_language(XORD(*LANGUAGE_CODE(LITERAL)));
		break;

	   default:
		bad_lcmd("argument",pa-2);
		break;
		}
	break;

   @<|outer_char| cases for |TEX|@>:
	@<Issue warning...@>@;
	switch(*(pa+1))
		{
	   case '{':
		set_filter(TEX);
		break;

	   case '\0':
		ini_language(XORD(*LANGUAGE_CODE(TEX)));
		break;

	   default:
		bad_lcmd("argument",pa-2);
		break;
		}
	break;

   default:
	bad_lcmd("command",pa-2);
	break;
	}
}

@ Not all options set the language.
@<Func...@>=
SRTN FR_args FCN((Language))
	LANGUAGE Language C1("")@;
{
int lnum;

@<Issue warning if this command is negated@>@;

if(isdigit(*pa))
	switch(*pa++)
		{ // Options \.{-n7} or \.{-n9}.
		case '7': 
			Fortran88 = NO; 
			ini_language(XORD(*LANGUAGE_CODE(Language)));
			break;

		case '9':
			Fortran88 = YES;
			ini_language(XORD(*LANGUAGE_CODE(Language)));
			break;

		default: 
			bad_loption(Language); @+ break;
		}
else 
  {
  lnum = lan_num(language); /* We need to set this so that we can
access the language arrays  properly.  ??? Language ??? */

  switch(*pa++)
	{
   case '\\':
   case '&':
	 /* Set the continuation character; for \Fortran, turn on
free-form syntax. */
	if(is_FORTRAN_(Language)) 
		params.Free_form_input[lnum] = NOT(FREE_FORTRAN);
	params.In_escape[lnum] = *(pa-1); // Continuation character.
	break;

   case ';':
	params.Auto_semi[lnum] = BOOLEAN(YES ^ not);
	break;

   case '!':
	params.Point_comments[lnum] = BOOLEAN(YES ^ not);
	break;

   case '/':
	params.CPP_comments[lnum] = BOOLEAN(YES ^ not);
	break;

   case ')':
	params.Reverse_indices[lnum] = BOOLEAN(YES ^ not);
	break;

   case 'b':
   case 'B':
	params.Block_nums[lnum] = NOT(BLOCK_NUMS); @+ break;

   case 'g':
   case 'G':
	@<Option \.{-g}:  set |goto| parameters@>@;
	break;

   case 'k':
	suppress_cmds = BOOLEAN(YES ^ not);
	@<Copy abbreviation characters@>@;
	break;

   case 'K':
	suppress_cmds = BOOLEAN(NO ^ not);
	@<Copy abbrev...@>@;
	break;

   case 'p':
	if(is_FORTRAN_(Language)) params.Prn_semis = NOT(PRN_SEMIS);
	break;

   case '{':
	pa--;
	set_filter(Language); 
	break;

   case '\0':
 // Specify the language.  Note that the other commands don't.
	ini_language(XORD(*LANGUAGE_CODE(Language)));
	break;

   default:
	bad_loption(Language);
	break;
	}
  }
}


@ 
@<Option \.{-g}...@>=
{
if(is_RATFOR_(Language))
	{
	if(!RAT_OK("'g' command ignored")) break;
	@<Scan the |goto| parameters@>;
	}
else bad_loption(Language);
}

@ Here we have some definitions for the parameters that control \Ratfor's
|goto|. (See the user manual.)

@d G_RATIO 2.0
@d MIN_G_RATIO 0.0 // This value definitively turns off the computed |goto|.

@d MARGINAL_CASES 5L
@d MIN_MARGINAL_CASES 1

@d MAX_SPREAD UL(128L)
@d MIN_MAX_SPREAD 1

@<Common...@>=

double g_ratio = G_RATIO;
unsigned short marginal_cases = MARGINAL_CASES;
CASE_TYPE max_spread = MAX_SPREAD;

@ We define an error macro to help ensure that valid parameters are passed
to the \.{-g}~option.

@m CHK_G(var,VAR,type) if(var < MIN_##VAR)
	{
	err_print(C,$IFELSE(type,int,"Invalid 'g' option: %s must be >= %d",
			"Invalid 'g' option: %s must be >= %.1f"),#var,
		MIN_##VAR);
	var = VAR;
	}

@<Scan the |goto|...@>=
{
while(*pa)
	if(isalpha(*pa))
		switch(*pa++)
			{
			case 'r':
			case 'R':
				g_ratio = STRTOD(pa,&pa);
				CHK_G(g_ratio,G_RATIO,double);
				break;
			case 'm':
			case 'M':
				marginal_cases = 
					(unsigned short)STRTOL(pa,&pa,10); 
				CHK_G(marginal_cases,MARGINAL_CASES,int);
				break;
			case 's':
			case 'S':
				max_spread = STRTOL(pa,&pa,10); 
				CHK_G(max_spread,MAX_SPREAD,int);
				break;
			default:
				err_print(C,"Invalid 'g' option: \
parameter type '%c'",*(pa-1));
				break;
			}
}

@* Option {\tt -k}.
If there are no abbreviation characters, we assume
that all are intended, so we insert an asterisk.

@<Copy abbrev...@>=
{
if(!*pa) STRCPY(abbrev_cmds,"*");
else STRNCPY(abbrev_cmds,pa,NUM_RATFOR_CMDS);
}


@*1 Option {\tt -p}.
Each use of this option collects its string argument
as a separate line in a style-file buffer.  That buffer is read before the
local style file.

@d SPRM_LEN 1500

@<Option \.{-p}...@>=
{
extern outer_char HUGE *sprm_buf,HUGE *sprm_ptr,HUGE *sprm_end;
int n = STRLEN(pa);
size_t nbuf,nused;

if(!sprm_buf) 
	{
	sprm_ptr = sprm_buf = GET_MEM("sprm_buf",SPRM_LEN,outer_char);
	sprm_end = sprm_buf + SPRM_LEN;
	nbuf = SPRM_LEN;
	}

if(sprm_ptr + n >= sprm_end) 
	{ /* Reallocate a larger buffer. */
	nused = sprm_ptr - sprm_buf;
	nbuf = sprm_end - sprm_buf + SPRM_LEN;

	if( (sprm_buf = (outer_char HUGE *)REALLOC(sprm_buf,
		nbuf*sizeof(outer_char)))==NULL)
		OVERFLW("sprm_buf",0);

	sprm_ptr = sprm_buf + nused;
	sprm_end = sprm_ptr + nbuf;
	}

/* Add a line (terminated with space and newline). */
STRCPY(sprm_ptr,pa);
sprm_ptr += n;
*sprm_ptr++ = ' ';
*sprm_ptr++ = '\n';
}

@*1 Option {\tt -P}.
In a few cases it is useful to know which processor,
\TeX\ or \LaTeX, will be used to process the output from \FWEAVE.  The
default is~`\.{-P}', which is equivalent to~`\.{-PT}'.

@<Option \.{-P}...@>=
{
switch(*pa)
	{
   case 'L':
	TeX_processor = LaTeX_p;
	break;

   default:
	err_print(C,"'%c' is invalid option for -X; must be either 'L' \
(LaTeX) or 'T' (TeX).  TeX is assumed",*pa); // Falls through to \TeX\ case.

   case '\0':
   case 'T':
	TeX_processor = TeX_p;
	break;
	}
}


@*1 Option {\tt -m}.
The \.{-m}~option takes care of several commands:
\.{-m4}~says to recognize \.{m4}~commands; \.{-m;}~means automatically
append as pseudo-semi to \WEB\ macro definitions; otherwise, it's a \WEB\
macro definition.

@<Option \.{-m}...@>=
{
switch(*pa)
	{
	case '4':
/* Recognize \.{m4} definitions. */
		@<Issue warning...@>@;
@#if 0
		R_ext = "m4"; N_ext = "n4";
@#endif
		m4 = !M4_;
		break;

	case ';':
/* Automatically append pseudo-semi to \.{WEB} macro definition. */
		auto_app_semi = NOT(AUTO_APP_SEMI);
		break;

	case '\0':
		 ERR_PRINT(C,"Missing id for 'm' option");
		break;

	default:
		if(not) goto undefine_macro;

	define_macro:
		mc = *pa;

		if(!(isalpha(mc) || mc=='_' || mc=='$'))
			err_print(C,"Macro definition may not start with \
'%c'; -m option ignored",mc);
		else SAVE_MACRO(pa); /* Macro definition. */

		break;
	}
}

@ Build a macro definition in the macro buffer. This is used for
predefining macros as well as defining from the command line. (This
function modifies the text~|t|.)

@<Func...@>=
SRTN save_macro FCN((cmd,t))
    CONST outer_char HUGE *cmd C0("Name of the ``at'' command to put first.")@;
	outer_char HUGE *t C1("Text of the definition.")@;
{
eight_bits HUGE *p;
boolean replace_equals = BOOLEAN(STRCMP(cmd,"m")==0); /* For macros, if an
	equals sign appears before a space, it will be turned into a space. */
	
if(program==weave) return;

p = mp;

/* Place command such as \.{@@m} into buffer. */
*mp++ = '@@'; 

while(*cmd)
	*mp++ = *cmd++; /* Copy text of command. */

*mp++ = ' ';

while(*t) 
	{
	if(replace_equals)
		if(*t == '=')
			{
			*t = ' ';
			replace_equals = NO;
			}
		else if(*t == ' ') replace_equals = NO;
	*mp++ = *t++;
	}

*mp++ = ' '; 
*mp = '@@'; @+ *(mp+1) = 'm';

/* After we've built it, convert to internal notation. */
for( ; p<mp+2; p++)
	*p = XORD(*p);
}

@ Divert the input stream to be from a buffer.
@<Glob...@>=

IN_COMMON ASCII HUGE *fbuffer, HUGE *flimit, HUGE *floc; /* Saved position
				of current file. */ 

@
@<Func...@>=
SRTN divert FCN((buffer,end,stop))
	ASCII HUGE *buffer C0("Start of the buffer.")@;
	ASCII HUGE *end C0("End of the buffer.")@;
	boolean stop C1("Stop when end is reached?")@;
{
stop_the_scan = stop;

fbuffer = cur_buffer;
flimit = limit;
floc = loc;

cur_buffer = loc = buffer;
limit = end; 

from_buffer = YES;
}

@ Undivert back to reading from files.
@<Func...@>=
SRTN undivert(VOID)
{
cur_buffer = fbuffer;
limit = flimit;
loc = floc;

from_buffer = NO;
}


@*1 Option {\tt -s}.
Process statistics requests.

@<Option \.{-s}...@>=
{
statistics = NOT(STATISTICS);

/* The format ``\.{-sm100}'' says to display memory allocations for sizes
$>= 100$ bytes. */
if(*pa)
	if(*pa == 'm')
		{ 
		pa++; // |pa| positioned to byte size.
		show_mem = NOT(SHOW_MEM);
		if(isdigit(*pa)) show_size = ATOL(pa);
		}
	else
		{
		printf("! Option \"%s\" is invalid.\n",pa-2);
		mark_harmless;
		}
}

@ On the smaller computers, it's helpful to know where we stand regarding
available memory. The function |mem_avail| is invoked along with the other
statistics turned on by the \.{-s}~command-line option.

A global variable is used to capture the starting memory, so we don't print
rediculously large maximum numbers with the statistics.

@<Glob...@>=

static BUF_SIZE starting_memory = ULONG_MAX; 
	// Set at first call to |mem_avail|.

@
@<Func...@>=

SRTN mem_avail FCN((at_end))
	int at_end C1("0 for beginning, 1 for end")@;
{
if(at_end) printf("\n Allocated maximum of %lu bytes dynamically; \
ended with %lu bytes.\n",max_mem,total_mem);

#if PRINT_AVAILABLE_MEMORY
	printf(" Available memory: %lu bytes.\n",CORE_LEFT);
	if(!at_end) 
		{
		starting_memory = CORE_LEFT; // Used in |smin0|.
		putchar('\n');
		}
#endif
}

@ Here is a common routine to print the statistics for a particular kind of
array. 
@a
SRTN stat0 FCN((name,size,num,max_num,abs_max_num,abbrev,ctrl_chars))
	CONST outer_char *name C0("")@;
	size_t size C0("")@;
	BUF_SIZE num C0("")@;
	BUF_SIZE max_num C0("")@;
	BUF_SIZE abs_max_num C0("")@;
	CONST outer_char *abbrev C0("")@;
	CONST outer_char *ctrl_chars C1("")@;
{
printf("  %s [\"%s\"] x %u byte(s):  %lu [%lu byte(s)] of %lu <= %lu%s\n",
	name,abbrev,size,num,num*size,max_num,abs_max_num,ctrl_chars);
}

@ A simple function to return the maximum ``reasonable'' memory.
@a
BUF_SIZE smin0 FCN((abs_max_num))
	BUF_SIZE abs_max_num C1("")@;
{
return MIN(starting_memory,abs_max_num);
}


@*1 Option {\tt -t}.
Truncate identifiers.

@<Option \.{-t}...@>=
{
@<Issue warning if this command is negated@>@;
ntrunc(); 
}

@ Parse the argument of the truncate (`\.{-t}') command.
@<Func...@>=
SRTN ntrunc(VOID)
{
LANGUAGE l;

truncate_ids = NO;

if(!*pa) goto bad_t_option;

while(*pa)
	{
	if(isdigit(*pa)) 
		l = (language==NO_LANGUAGE) ? GLOBAL_LANGUAGE : language; 
	else switch(*pa++)
		{
	   @<|outer_char| cases for |C|@>:       
		l = lcase(C,'\0',C_PLUS_PLUS,'+',&pa);
		break;
	   @<|outer_char| cases for |RATFOR|@>:  
		l = lcase(RATFOR,'7',RATFOR_90,'9',&pa);
		break;
	   @<|outer_char| cases for |FORTRAN|@>: 
		l = lcase(FORTRAN,'7',FORTRAN_90,'9',&pa);
		break;
	   @<|outer_char| cases for |LITERAL|@>:    
		l = LITERAL; @+ break;
	   @<|outer_char| cases for |TEX|@>:     
		l = TEX; @+ break;
	   default: 
	     bad_t_option:
		ERR_PRINT(C,"Invalid -t option.  Example:  `-tn=6{_}'"); 
		return;
		}
	
/* Skip over optional equals sign. */
	if(*pa == LANGUAGE_SEPARATOR) pa++;

/* Set the maximum identifier length for language~|l|. */
	truncate_ids = 
	   BOOLEAN(CHOICE((tr_max[lan_num(l)] = (unsigned short)ATOI(pa)) != 0,
			YES,NO));

	while(isdigit(*pa)) pa++; // Skip over the integer.

	if(*pa == '{') set_filter(l);
	}
}

@ Return a language based on the current argument character.
@<Func...@>=
LANGUAGE lcase FCN((l0,c0,l1,c1,pp))
	LANGUAGE l0 C0("")@;
	outer_char c0 C0("")@;
	LANGUAGE l1 C0("")@;
	outer_char c1 C0("")@;
	outer_char HUGE * HUGE *pp C1("")@;
{
if(c0 && **pp==c0)
	{
	while(**pp==c0) (*pp)++;
	return l0;
	}

if(c1 && **pp==c1)
	{
	while(**pp==c1) (*pp)++;
	return l1;
	}

return l0;
}

@ Set list of characters to strip from identifiers. The language command
`\.{-n\{abc\}}' sets the undesirable characters to `\.{abc}'.

@<Func...@>=
SRTN set_filter FCN((Language))
	LANGUAGE Language C1("")@;
{
if(!*pa) return; // In case there's no argument following the language cmd.

if(*pa == '{') pa++;

filter_char[lan_num(Language)] = (char *)pa; /* Repoint to the string of
				characters following this command. */

/* Remove the closing bracket from the list. */
for( ;*pa; pa++)
	if(*pa == '}')
		{
		*pa++ = '\0';
		return;
		}
}


@*1 Option {\tt -T}.
Various flags for \FTANGLE.

@<Option \.{-T}:  various flags for \FTANGLE@>=
{
outer_char HUGE *p = pa;

while(*p)
 switch(*p++)
	{
   case 'D':
	deferred_macros = NOT(DEFERRED_MACROS);
	break;

   case 'v':
	top_version = NOT(TOP_VERSION);
	break;

   case '%':
	keep_trailing_comments = NOT(KEEP_TRAILING_COMMENTS);
	break;

   default:
	bad_option();
	break;
	}
}

@*1 Option {\tt -u}.
Undefine a macro.

@<Option \.{-u}...@>=
{
if(not) 
	goto define_macro;

undefine_macro:
	if(*pa == '\0') 
		ERR_PRINT(C,"Missing identifier for `-u' option");
	else 
		save_macro(OC("#undef"),pa);
}


@*1 Option {\tt -W}.
Various flags for \FWEAVE.

@<Option \.{-W}:  various flags for \FWEAVE@>=
{
outer_char HUGE *p = pa;

while(*p)
 switch(*p++)
	{
   case '[':
	active_brackets = NOT(ACTIVE_BRACKETS);
	break;

   case 'd':
	defn_mask.outer_macros = NOT(PRN_OUTER_MACROS);
	break;

   case 'f':
	defn_mask.formats = NOT(PRN_FORMATS);
	break;

   case 'l':
	defn_mask.limbo = NOT(PRN_LIMBO);
	break;

   case 'm':
	defn_mask.macros = NOT(PRN_MACROS);
	break;

   case 'v':
	defn_mask.v = NOT(PRN_V);
	break;

   case 'w':
   case 'W':
	defn_mask.w = NOT(PRN_W);
	break;

   default:
	bad_option();
	break;
	}
}

@*1 Option {\tt -x}.
The \.{-x}~option has the format `\.{-x\It{[*cim]}}',
which controls the printing of the table of contents~(`\.{c}'),
index~(`\.{i}'), and module list~(`\.{m}').  `\.{*}"~means print nothing.
`\.{-xi}'~means don't print the index, but print everything else.  (More
precisely, `\.{*}'~is translated into the list~`\.{cim}'.  Each letter
negates the default action associated with it.)

@a
SRTN flags3 FCN((not))
	boolean not C1("")@;
{
prn_contents = BOOLEAN(PRN_CONTENTS ^ not);
prn_index = BOOLEAN(PRN_INDEX ^ not);
prn_modules = BOOLEAN(PRN_MODULES ^ not);

if(!(*pa)) 
	{ /* No argument.  Assume nothing is to be printed. */
	*pa = '*';
	*(pa+1) = '\0';
	}

for(; *pa; pa++)
	switch(*pa)
		{
	   case '*':
	   case '/':
		prn_contents = NOT(PRN_CONTENTS);
		prn_index = NOT(PRN_INDEX);
		prn_modules = NOT(PRN_MODULES);
		break;

	   case 'C':
	   case 'c':
		prn_contents = NOT(PRN_CONTENTS);
		break;

	   case 'I':
	   case 'i':
		prn_index = NOT(PRN_INDEX);
		break;

	   case 'M':
	   case 'm':
		prn_modules = NOT(PRN_MODULES);
		break;

	   default:
		err_print(C,"'%c' is invalid argument for -x; must be \
element of set {*cim}",*pa);
		break;
		}

no_xref = BOOLEAN(!(prn_index || prn_modules));
}

@*1 Option {\tt -y}.
The `\.{-y}~command has two forms:  a query mode,
``\.{-y$aa$?}'', or the setting mode, ``\.{-y$aa$\It{nnnnn}}''.  To query
all options, say ``\.{-y?}'' 

@<Option \.{-y}...@>=
@{
outer_char abbrev[80],HUGE *a;
BUF_SIZE nunits;
MEM HUGE *m,HUGE *mmin = NULL, HUGE *mmax = NULL;
boolean query_mode = NO;

@b
@<Issue warning if this command is negated@>@;

if(!*pa)
	{ /* Query everything. */
	mmin = mem;
	mmax = mmin + (sizeof(mem)/sizeof(MEM) - 1);
	query_mode = YES;
	puts("Default memory allocation parameters:");
	}
else
	{ /* Abbreviation specified. */
	abbrev[0] = abbrev[1] = '\0'; /* Ensure the abbreviation gets
		terminated properly. */

	for(a=abbrev; isalpha(*pa); )
		*a++ = *pa++;

	TERMINATE(abbrev,2); // Max of two character abbreviation.

	if(!isdigit(*pa))
		{ /* Assume it's a question. */
		mmin = msearch(abbrev,0L);
		mmax = mmin + 1;
		query_mode = YES;
		}
	}

if(query_mode)
	for(m=mmin; m<mmax; m++)
		printf(" \"%-s\"%s x %d byte(s):\
  min = %lu, current = %lu [%lu byte(s)], max = %lu.\n",
			m->abbrev, m->abbrev[1] ? "" : " ",
			m->bytes, 
			m->min,	m->nunits, (m->nunits)*(m->bytes), m->max);
else
	{ /* Change setting. */
	nunits = ATOL(pa);
	msearch(abbrev,nunits); // Set the value.
	}

info_option = YES;
}

@*1 Option {\tt -z}.
Set name of style file.

@<Option \.{-z}@>=
{
@<Issue warning if this command is negated@>@;

if(STRLEN(pa) < MAX_FILE_NAME_LENGTH)
	{
	if(STRCMP(pa,".") == 0)
		{ /* Read default file in current directory. */
		if(NSPRINTF(style_file_name,
			".%c%s",PREFIX_END_CHAR,STYLE_FILE_NAME) >=
MAX_FILE_NAME_LENGTH) OVERFLW("./style_file_name","");
		}
	else
		STRCPY(style_file_name,pa);

	renamed_style = YES;
	}
else err_print(C,"Style file name too long; must be less \
than %d characters",MAX_FILE_NAME_LENGTH);
}


@*1 Options {\tt ->} and {\tt -=}.
Here we determine a new output file
name, with the command~\.{->}. If the argument is empty, everything goes to
|stdout|. Otherwise, the command must have the format \.{->l=name.ext}. If
the language~\.l is empty, all output is redirected to \.{name.ext}.  If
the name field is~'\.*', the name of the web file is used, but with the new
extension. Otherwise, both the new name and the new extension are used.

@d LANGUAGE_SEPARATOR '=' // Separates language from file name.

@<Func...@>=

SRTN redirect_output(VOID)
{
int k;

if(*pa == '\0') 
	{ /* Empty argument; send stuff to |stdout|. */
	new_fname(&tex_fname,OC("stdout"),NULL);

	for(k=0; k<NUM_LANGUAGES; k++)
		new_fname(params.outp_nm+k,OC("stdout"),NULL);
	}
else if(phase==2 && program==weave) return;
else
	{
	outer_char c,HUGE *pname;
	outer_char HUGE *q = (outer_char HUGE *)STRCHR(pa,LANGUAGE_SEPARATOR); 
		// Is there an '='?

	if(q==pa)
		{ /* ``\.{->=new\_name}'' */
		c = LANGUAGE_SEPARATOR;
		pname = q + 1; // Point to file name.
		}
	else if(q)
		{ /* ``\.{->c=new\_name}'' */
		c = *pa++; /* Language symbol. */
		pname = q; // Point to \.=.
		}
	else
		{ /* ``\.{->new\_name}'' */
		c = LANGUAGE_SEPARATOR;
		pname = pa; // Point to file name.
		}

	switch(c)
		{
	   @<|outer_char| cases for |C|@>:
		set_fname(lcase(C,'\0',C_PLUS_PLUS,'+',&pa),pname,YES);
		break;

	   @<|outer_char| cases for |RATFOR|@>:
		if(!RAT_OK("Redirection ignored")) break;

		set_fname(lcase(RATFOR,'7',RATFOR_90,'9',&pa),pname,YES);
		break;

	   @<|outer_char| cases for |FORTRAN|@>:
		set_fname(lcase(FORTRAN,'7',FORTRAN_90,'9',&pa),pname,YES);
		break;

	   @<|outer_char| cases for |LITERAL|@>:
		set_fname(LITERAL,pname,YES);
		break;

	   @<|outer_char| cases for |TEX|@>:
		set_fname(TEX,pname,YES);
		break;
			
   	   case LANGUAGE_SEPARATOR:
		new_fname(&tex_fname,pname,NULL);

		for(k=0; k<NUM_LANGUAGES; k++)
			new_fname(params.outp_nm+k,pname,NULL);

		break;

	   default:
		err_print(C,"Syntax error in output redirection \
command \"->\". Language must be one of 'c', 'r', 'n', `m', or `x',  not '%c'",
*(pa-1));
		break;
		}
	}
}

@ This function sets an alternative output file name. If the |check| field
is |YES|, we check to see that the string has the format ``\.{=stuff}''.

@a
SRTN set_fname FCN((l,s,check))
	LANGUAGE l C0("Language")@;
	outer_char HUGE *s C0("Remainder of command-line argument to parse")@;
	boolean check C1("Do we check for beginning colon?")@;
{
if(program==weave)
	err_print(C,"Can't redirect FWEAVE's TeX output by individual \
languages. Use \"->\" or \"-%cname.ext\"",LANGUAGE_SEPARATOR);

if(check)
	if(*s++ != LANGUAGE_SEPARATOR)
		{
		err_print(C,"Expected '%c' after language in \"->\"; \
command ignored",LANGUAGE_SEPARATOR);
		return;
		}

/* If the name begins with a '\.\#', it's filled in later with |wbflnm0|. */
new_fname(params.outp_nm+lan_num(l),*s ? s : (outer_char HUGE *)"stdout",NULL);
}


@*1 Warnings.
Some of the commands aren't naturally negatable; issue a warning.

@<Issue warning...@>=
cant_negate(pa-2);

@
@a
SRTN cant_negate FCN((s))
	outer_char HUGE *s C1("")@;
{
if(not) 
	{
	printf("! Can't negate option \"%s\"'; ignoring extra hyphen.\n",s);
	mark_harmless;
	}
}

@
@a
SRTN bad_lcmd FCN((type,pa0))
	CONST char *type C0("")@;
	CONST outer_char HUGE *pa0 C1("")@;
{
err_print(C,"Invalid language %s \"%s\"",type,pa0);
}

@
@<Func...@>=
SRTN bad_loption FCN((Language))
	LANGUAGE Language C1("")@;
{
printf("! Invalid language option \"%s\" for %s.\n",
	pa-3,is_FORTRAN_(Language) ? "Fortran" : "Ratfor");
mark_harmless;
}

@ 
@<Func...@>=
SRTN usage FCN((msg))
	CONST char *msg C1("")@;
{
outer_char temp[200];

sprintf((char *)temp,
	"%s!! Usage:  %s webfile[%cweb] [changefile[%cch]] [-option...]\n",
	msg,
	program==tangle ? "ftangle" : "fweave",
		wt_style.ext_delimiter,wt_style.ext_delimiter);

FATAL(temp,"");
}

@
@<Print change file warning...@>=
{
printf("! Warning: Ignoring multiple change file \"%s\".\n",THE_FILE_NAME);
mark_harmless;
continue;
}

@ 
@a
SRTN too_long(VOID)
{
FATAL("!! Filename too long: ", (CONST outer_char *)pa);
}

@ 
@a
SRTN bad_option(VOID)
{
printf("! Unknown option \"%s\" ignored.\n", pa-2); 
mark_harmless;
}
 
@ If a language was set on the command line, we issue a warning if the
limbo section overrode that.
@a
SRTN chk_override FCN((language0))
	LANGUAGE language0 C1("")@;
{
if(language != language0 && cmd_language != NO_LANGUAGE && cmd_language !=
	language) 
 err_print(C,"WARNING:  Command-line language %s overridden in limbo by %s",
   languages[lan_num(cmd_language)],languages[lan_num(language)]); 
}

@* OUTPUT.
Here is the code that opens the output file:
@^system dependencies@>

@<Scan arguments and open output files@>=
{
@<Allocate initial file names@>@;
scan_args();

/* If there's no \WEB\ file, it must be an info option. */
if(found_web)
	{
	ini_input_prms(WEB_FILE,(outer_char HUGE *)"",ABORT_ON_ERROR); 
		// Opens both input and change file.
	@<Remember the |web_file_name| and |change_file_name|@>;

	if(program == weave) open_tex_file();
	}

/* In case no explicit language commands are given, either on the command
line or in the file, before encountering the first module, pick a default. */
if(language == NO_LANGUAGE) 
	ini_language(XORD(*LANGUAGE_CODE(GLOBAL_LANGUAGE)));

global_params = params;  // Freeze the params after arguments have been read.
}

@ Initially, all output file names are empty.
@<Allocate initial file names@>=
{
int k;

/* We initialize the \It{local} name list; it's set to global later after
everything else is set. */
new_fname(&tex_fname,NULL,NULL);
new_fname(&fwebmac,NULL,NULL);

for(k=0; k<NUM_LANGUAGES; k++)
	new_fname(params.outp_nm+k,NULL,NULL);
}

@ Make a new file name.
@d DFLT_FNAME_LENGTH 20
@a
void new_fname FCN((pname,name,ext))
	outer_char HUGE * HUGE *pname C0("")@;
	outer_char *name C0("")@;
	outer_char *ext C1("")@;
{
outer_char temp[MAX_FILE_NAME_LENGTH];

/* An empty |name| means allocate some space. */
if(!name)
	*pname = GET_MEM("pname",DFLT_FNAME_LENGTH+1,outer_char);
else
	{ /* Otherwise, we possibly allocate the space and construct the
name. */ 
	char ext_delimiter[2];
	FILE *temp_file_ptr;

	ext_delimiter[0] = (char)wt_style.ext_delimiter;
	ext_delimiter[1] = '\0';

	SPRINTF(MAX_FILE_NAME_LENGTH,temp,`"%s%s%s",name,ext ?
			ext_delimiter : "", 
		ext ? ext : (outer_char *)""`);

/* Previously we used to reallocate the file name here.  However, that
leads to an egregious error, since if the block is actually moved the old
pointers are still around on the stack and in various other hiding places.
Now, we just allocate a new area if the name is new. */
	was_opened(temp,0,pname,&temp_file_ptr);
	}
}

@
@<Remember the |web_file_name| and |change_file_name|@>=
@{
outer_char temp1[100],temp2[1000],
	full_web_name[ESCAPE_LENGTH],esc_full_web_name[ESCAPE_LENGTH],
	full_change_name[ESCAPE_LENGTH],esc_full_change_name[ESCAPE_LENGTH];
int n1,n2;

@b
/* Run time */
n1 = program==tangle ? NSPRINTF(temp1,
	 "\n  RUN TIME: \"%s, %s at %s.\"",
			the_day(t),the_cdate(t),the_time(t))
		: NSPRINTF(temp1,"");

#if(VMS)
	fgetname(web_file,full_web_name);
	fgetname(change_file,full_change_name);
#else
	STRCPY(full_web_name,web_file_name);
	STRCPY(full_change_name,change_file_name);
#endif /* |VMS| */

esc_file_name(esc_full_web_name,ESCAPE_LENGTH,full_web_name);
esc_file_name(esc_full_change_name,ESCAPE_LENGTH,full_change_name);

n2 = NSPRINTF(temp2,
	program==tangle ?
		"\n  WEB FILE:    \"%s\"\n  CHANGE FILE: %c%s%c" :
		" {\"%s\"} {%c%s%c} ",
	esc_full_web_name,
	*esc_full_change_name ? '"' : '(',
	*esc_full_change_name ? esc_full_change_name : OC("none"),
	*esc_full_change_name ? '"' : ')');

cmd_ln_buf = (outer_char HUGE *)REALLOC(cmd_ln_buf,STRLEN(cmd_ln_buf)+n1+n2+1);
STRCAT(cmd_ln_buf,temp1);
STRCAT(cmd_ln_buf,temp2);
}

@ For some system such as DOS, the file names may have special characters
in them that need to be escaped:
@a
unsigned esc_file_name FCN((esc_name,max_length,name))
	outer_char *esc_name C0("Put answer into here")@;
	unsigned max_length C0("Maximum length of |esc_name|.")@;
	outer_char *name C1("Put escapes into this name")@;
{
outer_char *pt,*pn;
unsigned n;

max_length--; /* Allow room for the final null. */

for(pt=esc_name,pn=name,n=0; *pn; )
	{
	if(program==weave)
	   switch(*pn)
		{
		case '\\': case '$': case '#': case '%':
		case '^': case '~': case '&': case '_':
			if(n < max_length)
				{
				n++;
				*pt++ = '\\';
				}
		}

	if(n < max_length)
		{
		n++;
		*pt++ = *pn++;
		}
	}

TERMINATE(pt,0);
return n;
}

@ The |update_terminal| macro is used when we want
to make sure that everything we have output to the terminal so far has
actually left the computer's internal buffers and been sent.
@^system dependencies@>

@d UPDATE_TERMINAL fflush(stdout) // Empty the terminal output buffer.

@ For single-character output we use |putchar| (to the terminal) and |putc|
(to a file). When we have to translate from \.{WEB}'s code into the
external character code, we must say things like |putchar(xchr[c])|.  When
we just want to print strings, we use |printf|.  
@^system dependencies@>

@d new_line putchar('\n') @d putxchar putchar

@<Func...@>=
SRTN ASCII_file_write FCN((file_ptr,p0,n))
	FILE *file_ptr C0("Standard file pointer.")@;
	CONST ASCII HUGE *p0 C0("Start of the buffer.")@;
	size_t n C1("Number of characters to write.")@;
{
CONST ASCII HUGE *p, HUGE *p1 = p0+n;
ASCII atemp[1000],HUGE *a,HUGE *a1;
size_t n_out;

if(n == 0) 
	return;

/* Translate any special characters into something readable. */
for(p=p0,a1=atemp; p<p1;a1++,p++)
	if(*p == interior_semi) 
		*a1 = @';';
	else 
		*a1 = *p;

if(translate_ASCII)
	{ /* Convert to the outer world. */
	outer_char temp[1000];
	outer_char HUGE *t;

	for(a=atemp,t=temp; a<a1;)
		*t++ = XCHR(*a++);

	n_out = FWRITE(temp,n,file_ptr);
	}
else 
	n_out = FWRITE(atemp,n,file_ptr);

if(n_out != 1)
	@<Diagnose a write error and give up@>@;
}

@
@<Diagnose...@>=
{
char temp[100];
int errno0 = errno;

sprintf(temp, "! WRITE ERROR: nbytes = %u, %u items written\n", n, n_out);
FATAL(temp, strerror(errno0));
}

@ The error routine |strerror| isn't available on all systems.
@a
#if !HAVE_STRERROR
char *strerror FCN((errnum))
	int errnum C1("")@;
{
static char temp[50];

sprintf(temp, "(strerror is not available; errno = %d)", errnum);
return temp;
}
#endif // |!HAVE_STRERROR|

@ The |args| array used by the macro processor must be allocated after
the command line is parsed, because |max_margs| might have been changed by
the \.{-y}~option.

@<Allocate dyn...@>=
{
if(program == tangle)
	{
	ALLOC(sixteen_bits, args, ABBREV(max_margs), max_margs, 1);
	max_margs++; // So the user thinks this is really the max \#.
	}
}

@* DATE, TIME, and TIMING.
Here are declarations for time and date. We use
many of the ANSI routines. (However, some of the following could be
simplified if the compiler were fully ANSI. Timing seems to be one of the
areas that's most difficult to get right on the various machines.)

@<Common...@>=

static CONST char *day[] =
   {"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"},
  *month[] = {"January","February","March","April","May","June","July",
			"August","September","October","November","December"};

@ Fill the |tm| structure and return a pointer.
@<Func...@>=
struct tm *the_localtime(VOID)
{
time_t the_tm;
time_t time PROTO((time_t *tp));

time(&the_tm);
return localtime(&the_tm);
}

@ Return strings containing the time and/or date.
@<Func...@>=
CONST outer_char *the_day FCN((t))
	CONST struct tm *t C1("")@;
{
return OC(day[t->tm_wday]);
}

#define NDATE 20

CONST outer_char *the_cdate FCN((t))
	CONST struct tm *t C1("")@;
{
static outer_char date_buf[NDATE];

if(NSPRINTF(date_buf,"%s %d, %d",
		month[t->tm_mon],t->tm_mday,1900+t->tm_year) >= NDATE)
			OVERFLW("Date","");
return (CONST outer_char *)date_buf;
}
#undef NDATE

#define NTIME 8

CONST outer_char *the_time FCN((t))
	CONST struct tm *t C1("")@;
{
static outer_char time_buf[NTIME];

if(NSPRINTF(time_buf,"%d:%02d",t->tm_hour,t->tm_min) >= NTIME)
	OVERFLW("Time","");

return (CONST outer_char *)time_buf;
}
#undef NTIME

@ Timing routines. In particular, sometimes we want timing more precise
than seconds, but the standard ANSI |difftime| doesn't always do that.
Thus, we sometimes supply our own.

@f TIME_T int

@<Common...@>=

clock_t clock0;
TIME_T time0;

#if NEW_DIFFTIME
double diff_time FCN((t1,t0))
	TIME_T t1 C0("")@;
	TIME_T t0 C1("")@;
{
#if HAVE_GETTIMEOFDAY
	return (double)(t1.tv_sec - t0.tv_sec) 
		+ 1.0e-6*(double)(t1.tv_usec - t0.tv_usec);
#else
#if HAVE_SYS_TIMEB_H
	return (double)t1.time - (double)t0.time 
		+ 1.0e-3*((double)t1.millitm - (double)t0.millitm); /*
Without the casts, this line didn't work right on the DECstation. I think
it has to do with the |unsigned short| type of |millitm|; a compiler bug
with type promotion. */
#else
	return t1 - t0;
#endif // |HAVE_SYS_TIMEB_H|
#endif
}
#endif /* |NEW_DIFFTIME| */

@ This function is called at the beginning of both \FTANGLE\ and \FWEAVE.
@<Func...@>=

SRTN ini_timer(VOID)
{
#if TIMING
	TIME(&time0);
	clock0 = clock();
#else
	puts("! Timing routines temporarily disabled");
#endif /* |TIMING| */
}

@ This one's called at the end.

@d TIMING_PREC 10 /* Check that |cpu <= wall| by multiplying seconds by
				this number, then truncating. */

@<Func...@>=

SRTN prn_time(VOID)
{
TIME_T time1;
double cpu,wall;
char less_than = NO;
char format[100]; /* We build the format for the time output here. */

#if TIMING

cpu = (clock()-clock0)/(double)(CLOCKS_PER_SEC);
TIME(&time1);

/* Because the real time is in units of seconds, we might get~0, so we'll
be fancy and print an inequality in that case. */
if( (wall = DIFFTIME(time1,time0)) == 0.0)
	{
	wall = 1.0;
	less_than = YES;
	}

SET_COLOR(timing);

/* --- CPU time --- */
sprintf(format,"CPU = %%.%df sec.",TIMING_WIDTH);
printf(format,cpu);
if(cpu >= 60.0) printf(" (%.2f min.)",cpu/60.0);

/* --- WALL CLOCK time --- */
sprintf(format,"; REAL %%s %%.%df sec.",TIMING_WIDTH);
printf(format,less_than ? "<=" : "=",wall);
if(wall >= 60.0) printf(" (%.2f min.).",wall/60.0);

/* --- PERCENTAGE CPU UTILIZATION --- */
printf("  CPU/REAL = %.1f%%.\n",100.0*(cpu/wall));

/* Debugging message: Check for compatibility. Because the timing routines
may not be perfectly compatible through all decimal places, we check only
that |cpu <= wall| to an accuracy of tenths of seconds. */
@#if 0
   if((unsigned long)(TIMING_PREC*cpu) > (unsigned long)(TIMING_PREC*wall))
	printf("! CPU (%.3f s.) > REAL (%.3f s.). \
Check for invalid CLOCKS_PER_SEC (%.3e) or type of clock().\n",
		cpu,wall,(double)CLOCKS_PER_SEC);
@#endif

SET_COLOR(ordinary);
	
#endif /* |TIMING| */
}

@* MISCELLANEOUS FUNCTIONS.
Here are various routines that didn't fit anywhere else.

@*1 Initializing |program|. 

@<Func...@>=
SRTN ini_program FCN((program0))
	PROGRAM program0 C1("")@;
{
program = program0; // Set global flag.

the_system = OC(THE_SYSTEM); /* |THE_SYSTEM| is defined in \.{os.hweb}. */
local_banner = OC(LOCAL_BANNER); /* See \.{os.hweb} and \.{custom.web}. */

ini_style(); // Default style file initializations.
}

@*1 Printing the banner line.
The annoyance here is that if this is to be in
color, the style file needs to be read first.  Temporarily, we've turned
that off. 
@a
SRTN banner(VOID)
{
@%SET_COLOR(ordinary);

printf("This is %s",DEBUG_XCHR ? "ScRaMbLeD " : "");

@%CLR_PRINTF(program_name,("%s",program==tangle ? "FTANGLE" : "FWEAVE"));
printf("%s",program==tangle ? "FTANGLE" : "FWEAVE");

printf(" [%s version %s (%s)]. %s\n",
	the_system,version,release_date,local_banner);
}

@*1 Announcing current file.
@a
SRTN reading FCN((in_name,emit_newline))
	CONST outer_char *in_name C0("")@;
	boolean emit_newline C1("")@;
{
CLR_PRINTF(info,("Reading")); @+ putchar(' ');
CLR_PRINTF(in_file,("%s",in_name));
CLR_PRINTF(info,("..."));
if(emit_newline) putchar('\n');
}

@
@a
SRTN writing FCN((print_write,out_name))
	boolean print_write C0("")@;
	CONST outer_char *out_name C1("")@;
{
if(print_write) {CLR_PRINTF(info,("\nWriting")); putchar(' ');}
CLR_PRINTF(out_file,("%s",out_name));
CLR_PRINTF(info,("..."));
fflush(stdout);
}

@* Printing the progress report for each starred module.
@a
SRTN progress(VOID)
{
if (*(loc-1)==@'*')
	{ /* Found a starred section. */
	if(err_happened)
		{
		putchar('\n');
		err_happened = NO;
		}
	else putchar(' ');
	CLR_PRINTF(module_num,("*%d",module_count));
	}

UPDATE_TERMINAL;
}

@*1 |nsprintf|.
The ANSI |sprintf| returns the number of characters
written; however, not all libraries are ANSI. The following function
|nsprintf| forces the issue.

@a
int nsprintf FCN(VA_ALIST((s,fmt,n VA_ARGS)))
	VA_DCL(
	outer_char *s C0("")@;
	CONST outer_char *fmt C0("")@;
	int n C2(""))@;
{
VA_LIST(arg_ptr)@;
#if(NUM_VA_ARGS == 1)
	outer_char *s;
	CONST outer_char *fmt;
	int n;
#endif

VA_START(arg_ptr,n);

#if(NUM_VA_ARGS == 1)
	s = va_arg(arg_ptr,outer_char *);
	fmt = va_arg(arg_ptr,outer_char *);
	va_arg(arg_ptr,int);
#endif

#if ANSI_SPRINTF
	return
#endif
vsprintf((char *)s,(CONST char *)fmt,arg_ptr);

/* Get to here if |!ANSI_SPRINTF|. */
va_end(arg_ptr);
return STRLEN(s);
}

@* INDEX.
