OS/2 Shareware BBS: 22 gnu/22-gnu.zip/fweb153.zip/fweb-1.53/web/common.web

Text File | 1995-09-23 | 200KB | 8,086 lines

@z --- common.web ---

FWEB version 1.53 (September 23, 1995)

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.53"
@d RELEASE "September 23, 1995"

@A
@<Possibly split into parts@>@;

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

/* For pc's, the file is split into two compilable parts using the
compiler-line macro |part|, which must equal either~1 or~2. */
#if(part != 2)
    @<Part 1@>@;
#endif /* Part 1 */

#if(part != 1)
    @<Part 2@>@;
#endif /* Part 2 */


@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. */
#ifdef borland
    extern unsigned _stklen = STKLEN;
#endif
#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...@>=

IN_COMMON ASCII xord[last_text_char+1]; // Converts input chars.\ to |ASCII|.
#ifdef scramble_ASCII
    ASCII xxord[last_text_char+1];  // For scrambling.
#endif
IN_COMMON 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:

@<Part 1@>=@[

SRTN
common_init(VOID)
{
IN_RATFOR 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@>@;

more_includes(wt_style.Idir);

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

@
@<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.)

@<Part 1@>=@[

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.)

@<Part 1@>=@[

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, bufsiz);
        bufsiz += 32;
        }

          if (buffer == NULL)
            FATAL(C, "!! 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.

@<Part 1@>=@[

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|.

@<Part 1@>=@[

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|.

@<Part 1@>=@[

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|.
@<Part 1@>=@[
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.

@<Part 1@>=@[

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...@>=

IN_COMMON BUF_SIZE delta_dots; // Expand the table in increments of this size.
IN_COMMON BUF_SIZE ndots; // The current total size.
IN_COMMON 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.

@<Part 1@>=@[

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.

@<Part 1@>=@[

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.

@<Part 1@>=@[

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), ndots*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 = PTR_DIFF(short, 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?

@<Part 1@>=@[

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...@>=

IN_COMMON BUF_SIZE buf_size; // Holds input line.

IN_COMMON 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;

IN_COMMON CMNT_DATA posns[50], HUGE *pcmnt CSET(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.

@<Part 1@>=@[

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...@>=

IN_COMMON long start_line CSET(1);
    // Must be |long|; a negative value is used as a flag.
IN_COMMON long end_line CSET(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,
            PTR_DIFF(unsigned, 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~'\.{@@}'.

@<Part 1@>=@[

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
{
char temp[200];
sprintf(temp, "please use the `-ybs...' option to increase buffer size from \
its present value of %lu characters", buf_size);
FATAL(C, "Input line too long; ", temp);
}

@<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)

@<Part 1@>=@[

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;
string_char = '\0';
in_char_string = 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')
    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 (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.

@<Part 1@>=@[

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;
}

@
@<Glob...@>=

IN_COMMON ASCII string_char;
IN_COMMON boolean in_char_string;

@

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

@<Part 1@>=@[

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 @'\'':
       case @'"':
        if(!scanning_C_cmnt)
            @<Check for \Fortran\ string@>@;
        break;

       case @'/':
        if(in_char_string || 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(in_char_string)
            break;

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

        break;
        }
}

@
@<Check for \F...@>=
{
if(!in_char_string)
    {
    in_char_string = YES;
    string_char = *p;
    break;
    }

if(string_char == *p && p[1] == string_char)
    {
    p++;
    break;
    }

in_char_string = NO;
}

@

@d BLANK_OUT(d) MEMSET((d)->pos,@' ',(d)->len)

@<Part 1@>=@[

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...@>=

IN_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...@>=

IN_COMMON ASCII HUGE *lp, HUGE *semi_pos;
IN_COMMON 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) = (ASCII)(((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.

@<Part 1@>=@[

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

string_char = '\0';
in_char_string = NO;

@<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...@>=

IN_COMMON ASCII HUGE *last_pos;
IN_COMMON 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)

@<Part 1@>=@[
boolean skip_Rtext(VOID)
{
static ASCII blank = @' ';

@<Begin skipping text@>;

last_pos = ␣

/* 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. */
@<Part 1@>=@[
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.

@<Part 1@>=@[

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|.

@<Part 1@>=@[

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@;

@<Part 2@>=@[

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...@>=

IN_COMMON INPUT_PARAMS change_params0
#if(part == 0 || part == 1)
     = {FORTRAN,OUTER,NO}
#endif
    ;

@
@<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@>

@
@<Initialize static...@>=
{
ALLOC(INPUT_PRMS, prms, ABBREV(max_include_depth), max_include_depth, 1);
}

@ Although the |prms| array had to be allocated before scanning the command
line (with the default |DFLT_MAX_INCLUDE_DEPTH|), the \.{-y}~option might
have requested a change in size.   If so, we reallocate the array.

@<Allocate dynamic...@>=
{
BUF_SIZE cur_prms_units;

alloc(OC("id"), &cur_prms_units, 0, -1); // What is current allocation?

if(cur_prms_units != DFLT_MAX_INCLUDE_DEPTH)
    prms = (INPUT_PRMS *)REALLOC(prms,
        (cur_prms_units + 1)*sizeof(INPUT_PRMS),
        (DFLT_MAX_INCLUDE_DEPTH+1)*sizeof(INPUT_PRMS));
}

@
@<Part 2@>=@[

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.
@<Part 2@>=@[

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 = 0;
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) ", (char *)file_type);
        FATAL(C, 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.
@<Part 2@>=@[

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.
@<Part 2@>=@[

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...@>=

IN_COMMON sixteen_bits module_count; // The current module number.

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

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

IN_COMMON 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.

@<Part 2@>=@[

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' && (skip_includes ||
        (program==weave && 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...@>=

IN_COMMON int stored_line_length;
IN_COMMON 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...@>=

IN_COMMON outer_char last_include_file[MAX_FILE_NAME_LENGTH] CSET(""),
    this_include_file[MAX_FILE_NAME_LENGTH] CSET("");

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

@b
push_stack:
 loc = cur_buffer + 2; // Position after \.{@@i}.

if(++incl_depth >= (int)max_include_depth)
    {
    incl_depth--;
    err_print(C, "Too many nested includes; %d allowed.  \
Increase with `-yid'.", 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(skip_ifiles)
        @<Skip an already-included file and |goto restart@;|@>@;

    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", (char *)cur_file_name));
/* Tell the terminal where we're reading from. */
        }
    else
        { /* Failed to open include file. */
            incl_depth--;
        }
     }

goto restart;
}

@ When option \.{-j} is used, include files that have already been included
are not included again.

@<Glob...@>=

IN_COMMON BUF_SIZE max_ifiles;
IN_COMMON int num_ifiles;
IN_COMMON outer_char **ifiles; // Dynamic array of unique include file names.

@
@<Allocate dynamic...@>=
{
ALLOC(outer_char *, ifiles, ABBREV(max_ifiles), max_ifiles, 0);
}

@
@<Skip an already...@>=
{
int j;

for(j=0; j<num_ifiles; j++)
    if(STRCMP(ifiles[j], cur_file_name) == 0)
        {
        incl_depth--;
        goto restart;
        }

if(num_ifiles == (int)max_ifiles)
    OVERFLW("unique include file names", ABBREV(max_ifiles));

if(phase == 1)
 {
 ifiles[num_ifiles] = GET_MEM("ifile", STRLEN(cur_file_name) + 1, outer_char);
 STRCPY(ifiles[num_ifiles], cur_file_name);
 }

num_ifiles++;
}

@ Read a file name from an \.{@@i}~line.  One annoyance is the possibility
of embedded comments.
@<Part 2@>=@[

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.

@<Part 2@>=@[

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.
@<Part 2@>=@[

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=PTR_DIFF(int, 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.

@<Part 2@>=@[

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|.

@<Part 2@>=@[

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|.

@<Glob...@>=

IN_COMMON BUF_SIZE total_mem CSET(0);
    // Current total dynamically allocated memory.
IN_COMMON BUF_SIZE max_mem CSET(0); // The maximum bytes that were allocated.

@
@<Part 2@>=@[

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.",
        (char *)why,nunits,(BUF_SIZE)nsize,total_mem);
    FREE(byte_mem); // Kludge to try to make it go out gracefully.
    FATAL(C, 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.
@<Part 2@>=@[

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 ",
        (char *)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? */

@<Part 2@>=@[

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.
@<Part 2@>=@[

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...@>=

IN_COMMON boolean show_mem CSET(SHOW_MEM);
IN_COMMON BUF_SIZE show_size CSET(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_IFILES 10
    #define DFLT_MAX_INCLUDE_DEPTH 10
    #define DFLT_MAX_MARGS 20
    #define DFLT_MAX_MODULES 400
    #define DFLT_MBUF_SIZE 32767
    #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_IFILES 100
    #define DFLT_MAX_INCLUDE_DEPTH 10
    #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...@>=

IN_COMMON MEM mem[]
   #if(part == 0 || part == 1)
     = {
    {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(max_include_depth), sizeof(INPUT_PRMS),
        1, DFLT_MAX_INCLUDE_DEPTH, 100}, // |"id"|.  |prms| (open files).
    {ABBREV(max_ifiles), sizeof(outer_char *),
        1, DFLT_MAX_IFILES, 10000}, // |"if"|.  |max_ifiles|.
    {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}
    }
    #endif // |part == 1|
    ;

IN_COMMON size_t sizeof_mem CSET(sizeof(mem));

@ 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.

@<Part 2@>=@[

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",
    (char *)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",
    (char *)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", (char *)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.

@<Part 2@>=@[

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.
@<Part 2@>=@[
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.

@<Part 2@>=@[
#ifdef mcc

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

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

if(new_ptr == NULL)
    return NULL;

num_to_copy = MIN(old_size, new_size);
ncopied = (size_t)num_to_copy;

if((BUF_SIZE)ncopied != num_to_copy)
    CONFUSION("hrealloc", "trying to copy more than size_t");

memcpy(new_ptr, old_ptr, ncopied);

FREE_MEM(old_ptr, "old_ptr", old_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.

@<Part 2@>=@[

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 = PTR_DIFF(int, s->id_end, s->id);
    }
else
    {
    p1 = (np+1)->byte_start;
    PROPER_END(p1);
    n = PTR_DIFF(int, 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...@>=

IN_COMMON name_pointer name_ptr; // First unused position in |byte_start|.
IN_COMMON 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|.

@<Part 2@>=@[

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 KEYWD:
        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|.

@<Part 2@>=@[

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,
        PTR_DIFF(unsigned, name_ptr, name_dir) - 1);
    return 0;
    }

PROPER_END(end);

len = PTR_DIFF(size_t, 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, NULL);
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), (char *)s));}
else
    id_info(p,(long)(n=(sixteen_bits)(p-name_dir)),s, NULL);

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

return n;
}

@I t_codes.hweb

@
@<Part 2@>=@[

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|; also in |see_reserved|.
@<Part 2@>=@[

SRTN
id_info FCN((np,n,s,prsrvd))
    name_pointer np C0("")@;
    long n C0("")@;
    CONST outer_char *s C0("")@;
    CONST RSRVD HUGE *prsrvd C1("")@;
{
if(n >= 0)
    printf(_Xx("Id %ld (0x%lx):"),n,n);

if(!prsrvd
   || (prsrvd->reserveds && np->reserved_word)
   || (prsrvd->intrinsics && np->intrinsic_word)
   || (prsrvd->keywords && np->keyword))
    printf(" \"%s\"\n", (char *)s);

if(!prsrvd)
    pr_lan("Language ",np->Language);

if(!prsrvd || prsrvd->reserveds)
    pr_lan("reserved ",np->reserved_word);

if(!prsrvd || prsrvd->intrinsics)
    pr_lan("intrinsic",np->intrinsic_word);

if(!prsrvd || prsrvd->keywords)
    pr_lan("keyword  ",np->keyword);
}

@
@<Glob...@>=

IN_COMMON boolean info_option CSET(NO);
IN_COMMON boolean see_rsrvd CSET(NO);
IN_COMMON RSRVD rsrvd
    #if(part == 0 || part == 1)
     = {NULL, NO, NO, NO}
    #endif // |part == 1|
    ;
IN_COMMON outer_char HUGE *style_args CSET(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);
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.
@<Part 2@>=@[
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|.
@<Part 2@>=@[

BUF_SIZE
prn_nd(VOID)
{
BUF_SIZE k, n = name_ptr - name_dir;

for(k=0; k<n; k++)
    {
    printf("[%lu]:  ", 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}.)

@<Part 2@>=@[

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.

@<Part 2@>=@[

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.

@<Part 2@>=@[

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.

@<Part 2@>=@[

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.
@<Part 2@>=@[

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.

@<Glob...@>=

IN_COMMON CONST char *origin_name[]
    #if(part == 0 || part == 1)
     = {"","COMMON","FTANGLE","FWEAVE","RATFOR","MACROS","STYLE"}
    #endif // |part == 1|
    ;

@
@<Part 2@>=@[

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;
#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], (char *)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 third 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", (char *)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", (char *)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(*k > 127 ? ' ' : 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(*k > 127 ? ' ' : 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;
IN_STYLE boolean from_sprm;

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

l = MIN(sloc,slimit);

for (k=sbuf; k<l; k++)
    putchar(*k > 127 ? ' ' : (*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 > 127 ? ' ' : *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.

@<Part 2@>=@[

int
fatal FCN((err_origin, s1, s2))
    ERR_ORIGIN err_origin C0("Where the error came from")@;
    CONST outer_char s1[] C0("Message 1.")@;
    CONST outer_char s2[] C1("Message 2.")@;
{
printf("\n");
if(err_origin != ERR_NULL)
    {
    CLR_PRINTF(fatal, ("! (%s):  ", origin_name[err_origin]));
    }
CLR_PRINTF(fatal,((char *)s1)); err0_print(ERR_NULL, s2, 0);
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.
@<Part 2@>=@[

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, `"\n    At %s:  %s.", where, why`);

beep(3);

return FATAL(NULL, "\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.
@<Part 2@>=@[

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.", (char *)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.",
        (char *)s, m->nunits, m->max, (char *)abbrev);
    }

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

@ A special case of |overflow| is useful for style-file parameters.
@<Part 2@>=@[

SRTN
new_sprm FCN((name, value))
    CONST outer_char name[] C0("Name of parameter.")@;
    int value C1("Integer value of parameters.")@;
{
char temp[100];

sprintf(temp, "Please increase style-file parameter `%s' from current value \
of %i;", name, value);
OVERFLW(temp, "");
}

@ 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@>

@<Part 2@>=@[

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

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

#if TIMING
    prn_time();
#endif // |TIMING|

@<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);

cls_files(); // Do stuff specific to \FTANGLE\ or \FWEAVE.
}

@
@<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.
@<Part 2@>=@[

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.
@<Part 2@>=@[

SRTN
out_error FCN((fcn))
    CONST outer_char fcn[] C1("")@;
{
FATAL(C, "!! 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? */
    all_includes FSET(ALL_INCLUDES); // Cross-reference all include files?
    auto_app_semi FSET(AUTO_APP_SEMI); /* For \.{WEAVE}, automatically
append a pseudo-semi to the end of \.{WEB} macro definitions? */
    auto_line FSET(AUTO_LINE); // Auto-insert line nums after \.{@@\%}?

/* 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.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? */
    Fortran_label FSET(FORTRAN_LABEL); // Label on same line?

    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.
    index_hidden FSET(INDEX_HIDDEN); // Index skipped includes files.
    input_macros FSET(INPUT_MACROS); /* Generate the default ``\.{\\input
                    fwebmac.tx}'' line? */
    lc_keywords FSET(LC_KEYWORDS); // Lower-case \Fortran\ keywords?
    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_XREF); // 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(PRN_SEMIS); // Print semicolons in \Fortran\ output?

    quoted_includes FSET(QUOTED_INCLUDES);
        // Cross-reference quoted include files?
    Ratfor77 FSET(RATFOR77); /* Expand \Ratfor\ code directly to
\Fortran-77? */
    read_iformats FSET(READ_IFORMATS); // Read include files for formats.
    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?
    rmv_files FSET(RMV_FILES); // Remove temporary files related to \.{-H}?

    skip_ifiles FSET(SKIP_IFILES); // \.{-j} --- skip files already included.
    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.
    xref_unnamed FSET(XREF_UNNAMED); // Xref unnamed stuff.
#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...@>=

IN_COMMON ASCII HUGE *pformat,HUGE *pdefault, HUGE *pdata,
    HUGE *pbp, HUGE *pinclude, HUGE *ppragma, 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"));
ppragma = x__to_ASCII(OC("pragma"));

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...@>=

IN_COMMON outer_char outp_buf[MAX_OUTPUT_LINE_LENGTH];
    // FORTRAN's output buffer.
IN_COMMON int nbuf_length CSET(72);

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

 /* Signifies the end of a directory prefix. */
IN_COMMON outer_char prefix_end_char CSET(PREFIX_END_CHAR);

IN_COMMON boolean all_std CSET(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...@>=

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

@
@<Part 2@>=@[

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", YES);
  if (!found_change) *change_file_name = '\0'; // This means null 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

@<Part 2@>=@[

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 (\.+ also works for backward
compatibility); those beginning with a '\.\&' are placed after the
command-line arguments.

@<Glob...@>=

IN_COMMON 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.
IN_COMMON outer_char HUGE * HUGE *pn0; // Marks end of ini args.
IN_COMMON FILE *ini_file CSET(NULL); // The ini file \.{.fweb}.

@

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

@d BEFORE_CHAR '-'
@d MIDDLE_CHAR '0'
@d AFTER_CHAR '&'

@<Part 2@>=@[

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(BEFORE_CHAR, ini_args,k);
    // Put those starting with '\.+' or '\.-' first.
pn0 = pn; // Mark end of the ini stuff.

acopy(MIDDLE_CHAR, (outer_char HUGE **)(*pargv), *pargc);
    // Then the command-line arguments.

acopy(AFTER_CHAR, 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 *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);

    more_includes(GETENV(ENV_INCLUDES));
#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...@>=

IN_COMMON INCL_PATHS incl;

@ 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.

@<Part 2@>=@[

SRTN
more_includes FCN((incl_list0))
    outer_char *incl_list0 C1("")@;
{
unsigned n;
BUF_SIZE old_size;

if(!incl_list0)
    return;

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

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

old_size = incl.size;
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, old_size);

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

    STRCAT(incl.list,incl_list0);
    }

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

@
@<Part 2@>=@[

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",
            (char *)env_var, (char *)file_name,
                *wbprefix ? (char *)wbprefix : ".");
        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.
@<Part 2@>=@[

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", (char *)file_name, (char *)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~'\.-'.
@<Part 2@>=@[

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_before = BOOLEAN(c==BEFORE_CHAR || c=='+');
boolean is_middle = BOOLEAN(c==MIDDLE_CHAR);
boolean is_after = BOOLEAN(c==AFTER_CHAR);
int k;

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

/* Look at all the arguments; copy them if appropriate. */
for(; k<n; k++,a++)
    {
    boolean before_entry = BOOLEAN((*a)[0] == BEFORE_CHAR || (*a)[0] == '+');

/* The following somewhat inscrutable logic puts file names and ``after''
entries from \.{.fweb} into the ``after'' list. */
    if( (!is_before && !before_entry) || (!is_after && before_entry) )
        {
        *pn = GET_MEM("*pn", STRLEN(*a)+1, outer_char);
        STRCPY(*pn, *a);
        if((*pn)[0] == '+' || (*pn)[0] == AFTER_CHAR)
            (*pn)[0] = BEFORE_CHAR;
        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@>@;
}

@
@<Part 2@>=@[

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.
@<Part 2@>=@[

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;

IN_COMMON SECT_INFO HUGE *sect_info;

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

@
@<Allocate dynamic...@>=

ALLOC(SECT_INFO, sect_info, ABBREV(max_modules), max_modules, 0);

@ 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.

@<Part 2@>=@[

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);
fclose(fa);
}

@
@<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 = PTR_DIFF(int, 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", (char *)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%[^}]",
       (char *)smodno, (char *)ssecno, (char *)spageno, (char *)smodno0);

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

modno = (sixteen_bits)ATOI(smodno);

if(modno >= max_modules)
    OVERFLW("sections", ABBREV(max_modules));

ps = sect_info + modno;

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

ps->pageno = (sixteen_bits)ATOI(spageno);
ps->modno0 = modno0 = (sixteen_bits)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

@<Part 2@>=@[

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)
    {
    outer_char letter[2];

    letter[1] = '\0';

    letter[0] = (ps->subpage_flag ?
        XCHR(modno - ps->modno0 + @'a' - 1) : '\0');

    if(letter[0] && XORD(letter[0]) > @'z')
        letter[0] = '?';

    SPRINTF(NMOD_TEMP, mod_temp, `"%s %d (sect. %s, p. %d%s)",
        prefix, modno, ps->secno, ps->pageno, letter`);
    }
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|.
@<Part 2@>=@[

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.

@<Part 2@>=@[

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.

@<Part 2@>=@[
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.

@<Glob...@>=

IN_COMMON outer_char style_file_name[MAX_FILE_NAME_LENGTH]
    CSET(STYLE_FILE_NAME);
IN_COMMON boolean renamed_style CSET(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...@>=

IN_COMMON boolean doing_cmd_line; // Command line or optional arguments?
IN_COMMON boolean cmd_prms; // Stuff from ini file or from command line?

@
@<Part 2@>=@[

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 */
IN_STYLE outer_char HUGE *sprm_ptr0, HUGE *sprm_ptr;

doing_cmd_line = doing_cmd_line0;
cmd_prms = NO;

*pfound_web = *pfound_change = NO;

while (argc-- > 0)
    {
    if(!cmd_prms && argv == pn0)
        { /* Note beginning of command-line parameters. */
        cmd_prms = YES;
        sprm_ptr0 = sprm_ptr;
        }

    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
    {
    printf("\n! File name \"%s\" is not allowed as optional argument; \
ignored.\n", pa);
    mark_harmless;
    }
}

@
@<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

@<Part 2@>=@[

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);
}

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.
@<Part 2@>=@[

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.

@<Part 2@>=@[

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 = (short)lan_index(language); // Maybe no longer used.
language_num = (short)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.
@<Part 2@>=@[

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.
@<Part 2@>=@[

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);

if(is_FORTRAN_(language))
    auto_semi = BOOLEAN(!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|.
@<Part 2@>=@[

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...@>=

IN_COMMON STMT_LBL max_stmt CSET(STARTING_DO_NUM);
IN_COMMON 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':
    @<Option \.{-D}:  see reserved words@>@;
    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 'H':
    @<Option \.{-H}:  scan include files@>@;
    break;

   case 'i':
    @<Option \.{-i}:  skip include files@>@;
    break;

   case 'I':
    more_includes(pa); // Add to include path list.
    break;

   case 'j':
    skip_ifiles = NOT(SKIP_IFILES); @~ break;

   case 'k':
    lc_keywords = NOT(LC_KEYWORDS);  @~ 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(FORTRAN_90)]
        = params.CPP_comments[LN(RATFOR)]
        = params.CPP_comments[LN(RATFOR_90)]
        = BOOLEAN(YES ^ not);
    break;

   case '!':
    params.Point_comments[LN(FORTRAN)]
        = params.Point_comments[LN(FORTRAN_90)]
        = params.Point_comments[LN(RATFOR)]
        = params.Point_comments[LN(RATFOR_90)]
        = 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 \.{-@@...@>=
{
if(!at_codes)
    {
    at_codes = GET_MEM("at_codes", 200, ASCII); // 200 is KLUDGE!
    at_codes[0] = '\0';
    }

STRCAT(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(FORTRAN_90)]
    = params.Block_nums[LN(RATFOR)]
    = params.Block_nums[LN(RATFOR_90)]
    = 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 Option {\tt -D}.
See reserved words.  The form `\.{-D[ikr]word}' says to print only the
intrinsic functions (`\.i'), and/or the \Fortran/\Ratfor\ keywords (`\.k'),
and/or the reserved words (`\.r') beginning with `\.{word}'.

Note that we can't immediately execute |see_reserved| because dynamic
memory and the |name_dir| hasn't been set up yet.
@<Option \.{-D}...@>=
{
if(*pa == '[')
    @<Get the optional arguments to `\.{-D}'@>@;
else if(!(*pa=='\0' || *pa=='*' || isalpha(*pa)))
    {
    err_print(C, "Either nothing, a letter, '*', or '[' must follow `-D'; \
option ignored");
    break;
    }

rsrvd.args = pa;

if(!*pa)
    rsrvd.reserveds = YES;

info_option = YES;
}

@
@<Get the optional arguments to `\.{-D}'...@>=
{
for(++pa; *pa != ']'; pa++)
    switch(*pa)
        {
       case 'i':
       case 'I':
        rsrvd.intrinsics = YES;
        break;

       case 'k':
       case 'K':
        rsrvd.keywords = YES;
        break;

       case 'r':
       case 'R':
        rsrvd.reserveds = YES;
        break;

       case '\0':
        err_print(C, "Missing ']' inserted after optional argument \
list to `-D'");
        break;

       default:
        err_print(C, "Optional argument to `-D' must be one of \
'i', 'k', or 'r'");
        break;
        }

pa++; // Advance past the \.{']'}.
}

@*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!)

@<Part 2@>=@[

SRTN
help(VOID)
{
puts("! For help, please see the texinfo entry for FWEB or use options\n\
 '-@@' (query control codes),\n\
 '-D' (query reserved words),\n\
 '-y' (query memory allocations),\n\
 '-Z' (query style-file parameters).");

usage("", NO); // In lieu of anything better.
}


@*1 Option {\tt -H}.

@<Option \.{-H}...@>=
{
outer_char HUGE *p = pa;

more_H:
switch(*p++)
    {
   case 'r':
    rmv_files = NOT(RMV_FILES); // For debugging.
    goto more_H;

   case 'x':
    quoted_includes = NOT(QUOTED_INCLUDES);
    goto more_H;

   case 'X':
    all_includes = NOT(ALL_INCLUDES);
    goto more_H;

   case '\0':
    read_iformats = NOT(READ_IFORMATS);
    break;

   default:
    bad_option();
    break;
    }
}

@*1 Option {\tt -i}.
When an include file is referenced by `\.{@@I}', then `\.{-i}' says for
\FWEAVE\ to not print the contents of the file.  `\.{-i!}' means to not
even read it (probably not useful).  By default, index entries are not made
for files that aren't printed; `\.{-ix}' says to index them anyway.

@<Option \.{-i}...@>=
{
switch(*pa)
    {
   case 'x':
    index_hidden = NOT(INDEX_HIDDEN); // Falls through.

   case '\0':
    toggle_includes = NOT(TOGGLE_INCLUDES); @~ break;

   case '!':
    skip_includes = NOT(SKIP_INCLUDES); @~ break;

   default:
    bad_option(); @~ break;
    }
}

@*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.
@<Part 2@>=@[

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| ??? Used to be |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 ':':
    if(is_FORTRAN_(Language))
        Fortran_label = NOT(FORTRAN_LABEL);
    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)) 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...@>=

IN_COMMON double g_ratio CSET(G_RATIO);
IN_COMMON unsigned short marginal_cases CSET(MARGINAL_CASES);
IN_COMMON CASE_TYPE max_spread CSET(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;
            }
}

@*1 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}...@>=
{
IN_STYLE outer_char HUGE *sprm_buf,HUGE *sprm_ptr,HUGE *sprm_end;
int n = STRLEN(pa);
size_t nbuf,nused;

if(!sprm_buf)
    { /* Allocate the style-parameter buffer. */
    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+2) >= sprm_end)
    { /* Reallocate a larger buffer. */
    BUF_SIZE old_size;

    nused = PTR_DIFF(size_t, sprm_ptr, sprm_buf);
    old_size = nbuf;
    nbuf = PTR_DIFF(size_t, sprm_end, sprm_buf) + SPRM_LEN;

    if( (sprm_buf = (outer_char HUGE *)REALLOC(sprm_buf,
        nbuf*sizeof(outer_char), old_size*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 specify which processor,
\TeX\ or \LaTeX, will be used to process the output from \FWEAVE.  The
default is~`\.{-P}', which is equivalent to~`\.{-PL}'.

@<Option \.{-P}...@>=
{
switch(*pa)
    {
   default:
    err_print(C,"'%c' is invalid option for -X; must be either 'L' \
(LaTeX) or 'T' (TeX).  LaTeX is assumed", *pa); // Falls through to \LaTeX\ case.

   case '\0':
   case 'L':
    TeX_processor = LaTeX_p;
    break;

   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|.)

@<Part 2@>=@[

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. */

@
@<Part 2@>=@[

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.
@<Part 2@>=@[
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", (char *)(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...@>=

IN_COMMON BUF_SIZE starting_memory CSET(ULONG_MAX);
    // Set at first call to |mem_avail|.

@
@<Part 2@>=@[

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.
@<Part 2@>=@[

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",
    (char *)name, (char *)abbrev, (unsigned)size, num, num*size, max_num,
        abs_max_num, (char *)ctrl_chars);
}

@ A simple function to return the maximum ``reasonable'' memory.
@<Part 2@>=@[

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.
@<Part 2@>=@[

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.
@<Part 2@>=@[

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}'.

@<Part 2@>=@[

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;

   case '#':
    auto_line = NOT(AUTO_LINE);
    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 '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{[*cimu]}}',
which controls the printing of the table of contents~(`\.{c}'),
index~(`\.{i}'), module list~(`\.{m}'), and unnamed
cross-references~(`\.{u}').  `\.{*}"~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.)

@<Part 2@>=@[

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);
xref_unnamed = BOOLEAN(XREF_UNNAMED ^ 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;

       case 'u':
        xref_unnamed = NOT(XREF_UNNAMED);
        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",
            (char *)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.

@<Part 2@>=@[

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:
#if 0 /* Don't want to do this; it screws up module labeling for \FWEAVE. */
        new_fname(&tex_fname,pname,NULL);
#endif

        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}''.

@<Part 2@>=@[

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);

@
@<Part 2@>=@[

SRTN
cant_negate FCN((s))
    outer_char HUGE *s C1("")@;
{
if(not)
    {
    printf("! Can't negate option \"%s\"'; ignoring extra hyphen.\n",
        (char *)s);
    mark_harmless;
    }
}

@
@<Part 2@>=@[

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);
}

@
@<Part 2@>=@[

SRTN
bad_loption FCN((Language))
    LANGUAGE Language C1("")@;
{
printf("! Invalid language option \"%s\" for %s.\n",
    (char *)(pa-3), is_FORTRAN_(Language) ? "Fortran" : "Ratfor");
mark_harmless;
}

@
@<Part 2@>=@[

SRTN
usage FCN((msg,is_fatal))
    CONST char *msg C0("")@;
    boolean is_fatal C1("Fatal?")@;
{
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);

if(is_fatal)
    FATAL(NULL, temp,"");
else
    wrap_up();
}

@
@<Print change file warning...@>=
{
printf("! Warning: Ignoring multiple change file \"%s\".\n",
    (char *)THE_FILE_NAME);
mark_harmless;
continue;
}

@
@<Part 2@>=@[

SRTN
too_long(VOID)
{
FATAL(NULL, "!! Filename too long: ", (CONST outer_char *)pa);
}

@
@<Part 2@>=@[

SRTN
bad_option(VOID)
{
printf("! Unknown option \"%s\" ignored.\n", (char *)(pa-2));
mark_harmless;
}

@ If a language was set on the command line, we issue a warning if the
limbo section overrode that.
@<Part 2@>=@[

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

@<Part 2@>=@[

SRTN
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;
BUF_SIZE old_size;

@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 ? '"' : ')');

old_size = STRLEN(cmd_ln_buf) + 1;
cmd_ln_buf = (outer_char HUGE *)REALLOC(cmd_ln_buf,old_size+n1+n2, old_size);
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:
@<Part 2@>=@[

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

@<Part 2@>=@[

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++)
    switch(*p)
        {
       case interior_semi:
        *a1 = @';';
        break;

       case MACRO_ARGUMENT:
        *a1++ = @'[';
        *a1++ = @'[';
        *a1++ = (ASCII)(@'0' + *(++p));
        *a1++ = @']';
        *a1 = @']';
        break;

       default:
        *a1 = *p;
        break;
        }

n = PTR_DIFF(size_t, a1, atemp);
    // Might be bigger than incoming~|n| because of macro arg.

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",
    (unsigned)n, (unsigned)n_out);
FATAL(NULL, temp, strerror(errno0));
}

@ The error routine |strerror| isn't available on all systems.
@<Part 2@>=@[

#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...@>=

IN_COMMON CONST char *day[]
    #if(part == 0 || part == 1)
     = {"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"}
    #endif // |part == 1|
    ;

IN_COMMON CONST char *month[]
    #if(part == 0 || part == 1)
     = {"January","February","March","April","May","June","July",
        "August","September","October","November","December"}
    #endif // |part == 1|
    ;

@ Fill the |tm| structure and return a pointer.
@<Part 2@>=@[

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.
@<Part 2@>=@[

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...@>=

#if TIMING

IN_COMMON clock_t clock0;
IN_COMMON 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|

#endif // |TIMING|

@ This function is called at the beginning of both \FTANGLE\ and \FWEAVE.
@<Part 2@>=@[

#if TIMING

SRTN
ini_timer(VOID)
{
    TIME(&time0);
    clock0 = clock();
}

#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. */

@<Part 2@>=@[

#if TIMING

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. */

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|.

@<Part 2@>=@[

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.
@<Part 2@>=@[

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",
    (char *)the_system, (char *)version, (char *)release_date,
    (char *)local_banner);
}

@*1 Announcing current file.
@<Part 2@>=@[

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", (char *)in_name));
CLR_PRINTF(info,("..."));

if(emit_newline)
    putchar('\n');
}

@
@<Part 2@>=@[

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", (char *)out_name));
CLR_PRINTF(info,("..."));
fflush(stdout);
}

@* Printing the progress report for each starred module.
@<Part 2@>=@[

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 {\bf nsprintf}.
The ANSI |sprintf| returns the number of characters
written; however, not all libraries are ANSI. The following function
|nsprintf| forces the issue.

@<Part 2@>=@[

int
nsprintf FCN(VA_ALIST((s,fmt,n VA_ARGS)))
    VA_DCL(
    outer_char *s C0("")@;
    CONST outer_char *fmt C0("")@;
    int n C2("")@;)@;
{
int num_char;
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
    num_char =
#endif

vsprintf((char *)s,(CONST char *)fmt,arg_ptr);

#if !ANSI_SPRINTF
    num_char = (int)STRLEN(s);
#endif

va_end(arg_ptr);

return num_char;
}

@* INDEX.