summaryrefslogtreecommitdiff
path: root/web/spiderweb/src/master/tangle.web
diff options
context:
space:
mode:
Diffstat (limited to 'web/spiderweb/src/master/tangle.web')
-rw-r--r--web/spiderweb/src/master/tangle.web1800
1 files changed, 1800 insertions, 0 deletions
diff --git a/web/spiderweb/src/master/tangle.web b/web/spiderweb/src/master/tangle.web
new file mode 100644
index 0000000000..26266034ca
--- /dev/null
+++ b/web/spiderweb/src/master/tangle.web
@@ -0,0 +1,1800 @@
+% Copyright 1989 by Norman Ramsey, Odyssey Research Associates
+% Not to be sold, but may be used freely for any purpose
+% For more information, see file COPYRIGHT in the parent directory
+
+% This file is part of Spidery WEB
+
+% This program by Norman Ramsey is based on programs Silvio Levy
+% and D. E. Knuth. Silvio Levy wrote most of the code.
+% It is distributed WITHOUT ANY WARRANTY, express or implied.
+% Dec 1987
+
+% Here is TeX material that gets inserted after \input webmac
+
+\message{OK, entering \string\batchmode...}
+\batchmode
+
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps
+\def\cee{C}
+\def\pb{$\.|\ldots\.|$} % C brackets (|...|)
+\def\v{\char'174} % vertical (|) in typewriter font
+\def\ceeref{{\it The C Reference Manual}}
+\mathchardef\RA="3221 % right arrow
+\mathchardef\BA="3224 % double arrow
+
+\def\title{Spidery TANGLE}
+\def\contentspagenumber{1} % should be odd
+\def\topofcontents{\null\vfill
+ \titlefalse % include headline on the contents page
+ \def\rheader{\hfil}
+ \centerline{\titlefont The {\ttitlefont Spidery TANGLE} processor}
+ \vfill
+}
+
+@* Introduction.
+\.{TANGLE} has a fairly straightforward outline. It operates in
+two phases: first it reads the source file, saving the \cee\ code in
+compressed form; then outputs the code, after shuffling it around.
+It can be compiled
+with certain optional flags, |DEBUG| and |STAT|, the latter being used
+to keep track of how much of \.{TANGLE}'s resources were actually used.
+
+@u
+@<Include files@>@;
+@<Common code for \.{WEAVE} and \.{TANGLE}@>@;
+@<Typedef declarations@>@;
+@<Global variables@>@;
+
+main (ac, av)
+char **av;
+{
+ argc=ac; argv=av;
+ program=tangle;
+ @<Set initial values@>;
+ common_init();
+ printf(banner); /* print a ``banner line'' */
+ phase_one(); /* read all the user's text and compress it into |tok_mem| */
+ phase_two(); /* output the contents of the compressed tables */
+ wrap_up();
+}
+
+@ The following parameters were sufficient in the original \.{TANGLE} to
+handle \TeX, so they should be sufficient for most applications of \.{TANGLE}.
+
+If you change |max_bytes|, |max_names| or |hash_size| you should also
+change them in the file |"common.web"|.
+
+@d max_bytes = 90000 /* the number of bytes in identifiers,
+ index entries, and module names; used in |"common.web"| */
+@d max_toks = 150000 /* number of bytes in compressed \cee\ code */
+@d max_names = 4000 /* number of identifiers, strings, module names;
+ must be less than 10240; used in |"common.web"| */
+@d max_texts = 2000 /* number of replacement texts, must be less than 10240 */
+@d hash_size = 353 /* should be prime; used in |"common.web"| */
+@d longest_name = 400 /* module names shouldn't be longer than this */
+@d stack_size = 50 /* number of simultaneous levels of macro expansion */
+@d buf_size = 100 /* for \.{WEAVE} and \.{TANGLE} */
+
+@i common.h
+
+@ Should include tlang.web but can't because AWK runs out of files.
+
+@* Data structures exclusive to {\tt TANGLE}.
+We've already seen that the |byte_mem| array holds the names of identifiers,
+strings, and modules;
+the |tok_mem| array holds the replacement texts
+for modules. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+A \&{text} variable is a structure containing a pointer into
+|tok_mem|, which tells where the corresponding text starts, and an
+integer |text_link|, which, as we shall see later, is used to connect
+pieces of text that have the same name. All the \&{text}s are stored in
+the array |text_info|, and we use a |text_pointer| variable to refer
+to them.
+
+The first position of |tok_mem| that is unoccupied by
+replacement text is called |tok_ptr|, and the first unused location of
+|text_info| is called |text_ptr|. Thus we usually have the identity
+|text_ptr->tok_start=tok_ptr|.
+
+If your machine does not support |char unsigned| you should change
+the definition of \&{eight\_bits} to |short unsigned|.
+@^system dependencies@>
+
+@<Typed...@>=
+typedef struct {
+ eight_bits *tok_start; /* pointer into |tok_mem| */
+ sixteen_bits text_link; /* relates replacement texts */
+} text;
+typedef text *text_pointer;
+
+@ @<Glob...@>=
+text text_info[max_texts];
+text_pointer text_info_end=text_info+max_texts-1;
+text_pointer text_ptr; /* first unused position in |text_info| */
+eight_bits tok_mem[max_toks];
+eight_bits *tok_mem_end=tok_mem+max_toks-1;
+eight_bits *tok_ptr; /* first unused position in |tok_mem| */
+
+@ @<Set init...@>=
+text_info->tok_start=tok_ptr=tok_mem;
+text_ptr=text_info+1; text_ptr->tok_start=tok_mem;
+ /* this makes replacement text 0 of length zero */
+
+@ 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|.
+
+@d equiv = equiv_or_xref /* info corresponding to names */
+
+@ @<Set init...@>=
+name_dir->equiv=(ASCII *)text_info; /* the undefined module has no replacement text */
+
+@ Here's the procedure that decides whether a name of length |l|
+starting at position |first| equals the identifier pointed to by |p|:
+
+@u
+names_match(p,first,l)
+name_pointer p; /* points to the proposed match */
+ASCII *first; /* position of first character of string */
+int l; /* length of identifier */
+{
+ if (length(p)!=l) return 0;
+ return !strncmp(first,p->byte_start,l);
+}
+
+@
+@u
+init_node(node)
+name_pointer node;
+{
+ node->equiv=(ASCII *)text_info;
+
+}
+init_p(p,t)
+name_pointer p;
+eight_bits t;
+{
+ p->ilk=t;
+}
+
+
+
+@*Tokens.
+ Replacement
+ texts, which represent \cee\ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p$ points to a replacement text, |p->tok_start| is the |tok_mem| position
+of the first eight-bit code of that text. If |p->text_link=0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a module. In the latter case |p->text_link| is either equal to
+|module_flag|, which means that there is no further text for this module, or
+|p->text_link| points to a continuation of this replacement text; such
+links are created when several modules have \cee\ texts with the same
+name, and they also tie together all the \cee\ texts of unnamed modules.
+The replacement text pointer for the first unnamed module appears in
+|text_info->text_link|, and the most recent such pointer is |last_unnamed|.
+
+@d module_flag = max_texts /* final |text_link| in module replacement texts */
+
+@<Glob...@>=
+text_pointer last_unnamed; /* most recent replacement text of unnamed module */
+
+@ @<Set init...@>= last_unnamed=text_info; text_info->text_link=0;
+
+@ If the first byte of a token is less than |@'200|, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |@'200<=a<@'250|, then |(a-@'200)@t${}\times2^8$@>+b|
+to an identifier; if |@'250<=a<@'320|, then
+|(a-@'250)@t${}\times2^8$@>+b| points to a module name; otherwise, i.e., if
+|@'320<=a<@'400|, then |(a-@'320)@t${}\times2^8$@>+b| is the number of the module
+in which the current replacement text appears.
+
+Codes less than @'200 are 7-bit ASCII codes that represent themselves.
+In particular, a single-character identifier like `|x|' will be a one-byte
+token, while all longer identifiers will occupy two bytes.
+
+Some of the 7-bit ASCII codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip \hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}).
+
+\hang |string| denotes the beginning or end of a string, verbatim
+construction or numerical constant.
+@^ASCII code@>
+
+@d string = @'2
+@d param = @'7
+@d join = @'177 /* ASCII delete will not appear */
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@u store_two_bytes(x)
+sixteen_bits x;
+{
+ if (tok_ptr+2>tok_mem_end) overflow("token");
+ *tok_ptr++=x>>8; /* store high byte */
+ *tok_ptr++=x&@'377; /* store low byte */
+}
+
+
+@* Stacks for output. The output process uses a stack to keep track
+of what is going on at different ``levels'' as the modules are being
+written out. Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level.
+
+\hang |mod_field| is the module number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_mod|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr=stack|.
+
+@<Typed...@>=
+typedef struct {
+ eight_bits *end_field; /* ending location of replacement text */
+ eight_bits *byte_field; /* present location within replacement text */
+ name_pointer name_field; /* |byte_start| index for text being output */
+ text_pointer repl_field; /* |tok_start| index for text being output */
+ sixteen_bits mod_field; /* module number or zero if not a module */
+} output_state;
+typedef output_state *stack_pointer;
+
+@ @d cur_end = cur_state.end_field /* current ending location in |tok_mem| */
+@d cur_byte = cur_state.byte_field /* location of next output byte in |tok_mem|*/
+@d cur_name = cur_state.name_field /* pointer to current name being expanded */
+@d cur_repl = cur_state.repl_field /* pointer to current replacement text */
+@d cur_mod = cur_state.mod_field /* current module number being expanded */
+
+@<Global...@>=
+output_state cur_state; /* |cur_end|, |cur_byte|, |cur_name|, |cur_repl|
+ and |cur_mod| */
+output_state stack[stack_size+1]; /* info for non-current levels */
+stack_pointer stack_ptr; /* first unused location in the output state stack */
+stack_pointer stack_end=stack+stack_size; /* end of |stack| */
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_info->text_link| is nonzero,
+since it points to the \cee\ text in the first unnamed module that generates
+code; if there are no such modules, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr=stack+1; cur_name=name_dir; cur_repl=text_info->text_link+text_info;
+cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start; cur_mod=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+We assume that the C compiler can copy structures.
+@^system dependencies@>
+
+@u push_level(p) /* suspends the current level */
+name_pointer p;
+{
+ @<Trace the name of what's pushed (|#ifdef TRACE_MACROS|)@>;
+ if (stack_ptr==stack_end) overflow("stack");
+ *stack_ptr=cur_state;
+ stack_ptr++;
+ cur_name=p; cur_repl=(text_pointer)p->equiv;
+ cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start;
+ cur_mod=0;
+}
+
+@ @<Trace the name of what's pushed (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+ if (tracing>0) {
+ printf("\nPushing "); print_id(p);
+ printf(" =nd[%d]",p-name_dir);
+ }
+#endif TRACE_MACROS
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing:
+It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level.
+If this level is the end of a macro definition, it pops all the parameters
+off the stack.
+
+@u pop_level() /* do this when |cur_byte| reaches |cur_end| */
+{ int number_of_parameters;
+@<Trace the name of what's popped (|#ifdef TRACE_MACROS|)@>;
+ if (cur_repl->text_link==0) { /* macro definition */
+ if (cur_name->ilk==macro) {
+ @<Pop the parameters from the parameter stack@>;
+ }
+ } else if (cur_repl->text_link<module_flag) { /* link to a continuation */
+ cur_repl=cur_repl->text_link+text_info; /* stay on the same level */
+ cur_byte=cur_repl->tok_start; cur_end=(cur_repl+1)->tok_start;
+ return;
+ }
+ stack_ptr--; /* go down to the previous level */
+ if (stack_ptr>stack) cur_state=*stack_ptr;
+}
+
+
+@ @<Pop the parameters...@>=
+number_of_parameters=*(cur_repl->tok_start);
+@<Trace number of parms popped (|#ifdef TRACE_MACROS|)@>;
+while (number_of_parameters-->0) {
+ name_ptr--; text_ptr--;
+#ifdef TRACE_MACROS
+byte_ptr-=2;
+#endif TRACE_MACROS
+ }
+#ifdef STAT
+#ifdef STAT_HAS_BEEN_FIXED
+ if (tok_ptr>max_tok_ptr) max_tok_ptr = tok_ptr;
+ /* maximum value of |tok_ptr| occurs just before
+ parameter popping */
+#endif STAT_HAS_BEEN_FIXED
+#endif STAT
+tok_ptr = text_ptr->tok_start;
+
+
+@ @<Trace number of parms popped (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>1) {
+ printf("\nUnstacking %d parameters",number_of_parameters);
+ }
+#endif TRACE_MACROS
+@ @<Trace the name of what's popped (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+ if (tracing>0) {
+ printf("\nPopping "); print_id(cur_name);
+ printf(" =nd[%d]",cur_name-name_dir);
+ }
+
+#endif TRACE_MACROS
+
+
+
+@*1 Expanding macros.
+ The heart of the output procedure is the |get_output| routine, which produces
+the next token of output that is not a reference to a macro. This procedure
+handles all the stacking and unstacking that is necessary.
+
+@ Before we can get on to |get_output|,
+we have to talk about expanding macros.
+Macro parameters must be stacked.
+They are placed in |tok_mem| just
+above the other replacement texts, and dummy parameter ``names'' are
+placed in |byte_start| just after the other names.
+The variables |text_ptr| and |tok_ptr| essentially serve
+as parameter stack pointers during the output phase, so there is
+no need for a separate data structure to handle this problem.
+
+
+@ Here are our invariants (assuming $\#$ represents |param|):
+(1) in a replacement text, $\#n$ always refers to |*(name_ptr-n)|.
+(2) when a parameter is scanned, any $\#n$ are replaced with references
+to the appropriate name, so that the replacement text for a parameter
+never contains a $\#n$.
+(3) |name_ptr| is not changed until all the parameters are scanned;
+otherwise invariant (1) wouldn't work during parameter scanning.
+(4) when all parameters are scanned, |name_ptr| is moved
+so that $\#n$ in the replacement text will be interpreted correctly.
+(5) When we have finished scanning the replacement text for a macro, we
+have to pop |name_ptr| to maintain the invariant in (1).
+
+@ |get_output| returns the value |module_number|
+if the next output begins or ends the replacement text of some module,
+in which case |cur_val| is that module's number (if beginning) or the
+negative of that value (if ending). (A module number of 0 indicates
+not the beginning or ending of a module, but a \&{\#line} command.)
+And it returns the value |identifier|
+if the next output is an identifier of length two or more, in which case
+|cur_val| points to that identifier name.
+
+@d module_number = @'201 /* code returned by |get_output| for module numbers */
+@d identifier = @'202
+@<Global...@>=
+int cur_val; /* additional information corresponding to output token */
+
+
+@ If |get_output| finds that no more output remains, it returns the value zero.
+@u sixteen_bits
+get_output() /* returns next token after macro expansion */
+{
+ sixteen_bits a; /* value of current byte */
+ restart: if (stack_ptr==stack) return 0;
+ if (cur_byte==cur_end) {
+ cur_val=-((int)cur_mod); /* cast needed because of sign extension */
+ pop_level();
+ if (cur_val==0) goto restart;
+ out_char(module_number); return;
+ }
+ a=*cur_byte++;
+ if (a<@'200)
+ if(a==param) {
+ @<Trace parameter number (|#ifdef TRACE_MACROS|)@>;
+ @<Get the parameter number, set up to substitute
+ that parameter, and go to |restart|@>;
+ } else
+ out_char(a); /* one-byte token */
+ else {
+ a=(a-@'200)*@'400+*cur_byte++;
+ switch (a/@'24000) { /* |@'24000=(@'250-@'200)*@'400| */
+ case 0:
+ @<If |a| is a macro, set it up and go to |restart|@>;
+ cur_val=a; out_char(identifier); break;
+ case 1: @<Expand module |a-@'24000|, |goto restart|@>;
+ default: cur_val=a-@'50000; if (cur_val>0) cur_mod=cur_val;
+ out_char(module_number);
+ }
+ }
+ return 1;
+}
+
+
+@ @<Get the parameter number...@>=
+push_level(name_ptr-*cur_byte++); goto restart;
+@ @<Trace parameter number...@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf (" [#%d]",*cur_byte);
+ }
+#endif TRACE_MACROS
+
+@ @<If |a| is a macro...@>=
+if (name_dir[a].ilk==macro) {
+ @<Trace macro expansion (|#ifdef TRACE_MACROS|)@>;
+ @<Scan the parameters (if any) and stack them,
+ or go to |restart| if an error occurs@>;
+ push_level(name_dir+a);
+ cur_byte++; /* skip number of parameters */
+ goto restart;
+} else if (name_dir[a].ilk==simple) {
+ @<Trace parameter expansion (|#ifdef TRACE_MACROS|)@>;
+ push_level(name_dir+a);
+ goto restart;
+}
+
+@ @<Trace macro expansion (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf("\nExpanding macro ("); print_id(name_dir+a);
+ printf("=nd[%d])",a);
+ }
+#endif TRACE_MACROS
+
+@ @<Trace parameter expansion (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf("\nExpanding parameter ("); print_id(name_dir+a);
+ printf("=nd[%d])",a);
+ }
+#endif TRACE_MACROS
+
+
+@ @<Scan the parameters...@>=
+{int number_of_parameters;
+ while (cur_byte==cur_end && stack_ptr>stack) pop_level();
+ number_of_parameters = *(((text_pointer)name_dir[a].equiv)->tok_start);
+ if (number_of_parameters>0) {
+ if (stack_ptr==stack || *cur_byte!=@`(') {
+ printf("\n! No parameters given for ");
+ print_id(a+name_dir);
+ err_print("");
+ goto restart;
+ }
+ cur_byte++; /* skip left parenthesis */
+ parm_ptr = name_ptr; /* maintain |name_ptr| invariant */
+ while (number_of_parameters-->0) {
+ @<Stack a parameter ending in
+ comma or parenthesis@>;
+ }
+ name_ptr=parm_ptr; /* we are about to |push_level|,
+ so this maintains the |name_ptr| invariant */
+ }
+}
+
+@ In scanning parameter lists, we require that parameters be separated
+by commas, and that parentheses balance in parameters.
+The balancing is done with the array |balances|, and {\tt SPIDER}
+could easily be extended to make certain tokens {\tt balance left} and
+other tokens {\tt balance right}, so that {\tt left} and {\tt right}
+tokens balance in parameters.
+@ @<Global variables@>=
+short balances[@'200];
+@ @<Set initial values@>=
+{ int i;
+for (i=0;i<@'200;i++) balances[i]=0;
+@<Set special |balances|@>;
+}
+@ Eventually we will want {\tt SPIDER} to set balances.
+For now let's try just tossing in parenthesis, braces, and square brackets.
+@<Set special |balances|@>=
+balances[@`(']=1;
+balances[@`)']=-1;
+balances[@`[']=1;
+balances[@`]']=-1;
+balances[@`{']=1;
+balances[@`}']=-1;
+
+@ @<Stack a parameter...@>=
+{ int bal; /* used to balance parentheses in parameter lists */
+ eight_bits b, oldb;
+ sixteen_bits c;
+bal=0;
+@<Trace scanning for stack (|#ifdef TRACE_MACROS|)@>;
+while (1) {
+ b=*cur_byte++;
+ if (b==param) { /* convert to name reference */
+ b=*cur_byte++;
+ @<Trace parameter scansion (|#ifdef TRACE_MACROS|)@>;
+ c=name_ptr-name_dir-b; /* |name_ptr-b| points to parm */
+ app_repl(@'200 + (c/@'400));
+ app_repl(c % @'400);
+ } else {
+ if (b>=@'200) {
+ @<Trace scansion of token in |b| (|#ifdef TRACE_MACROS|)@>;
+ app_repl(b);
+ b=*cur_byte++;
+ } else if (bal==0 && ((number_of_parameters==0 && b==@`)')
+ || (number_of_parameters>0 && b==@`,'))) {
+ goto done;
+ } else if (@<|b| opens verbatim or string@>) {
+ @<Copy verbatim or string token list beginning with |b|@>;
+ } else {
+ @<Trace scansion of ordinary token in |b|@>;
+ bal += balances[b];
+ }
+ app_repl(b);
+ }
+}
+done:
+parm_ptr->equiv=(ASCII *)text_ptr;
+text_ptr->text_link=0; /* label a macro */
+parm_ptr->ilk=simple; /* treat parm \# like simple macro */
+#ifdef TRACE_MACROS
+if(byte_ptr+2>=byte_mem_end) overflow("byte memory");
+*byte_ptr++=@`#'; *byte_ptr++=number_of_parameters+1+@`0';
+#endif TRACE_MACROS
+if (parm_ptr>=name_dir_end) overflow ("name");
+(++parm_ptr)->byte_start=byte_ptr;
+ if (text_ptr>=text_info_end) overflow("text");
+ (++text_ptr)->tok_start=tok_ptr;
+@<Trace stacking the parameter (|#ifdef TRACE_MACROS|)@>;
+}
+
+@ @<Global variables@>=
+name_pointer parm_ptr; /* used while stacking parameters */
+
+@ @<|b| opens verbatim or string@>=(b==string||b==constant)
+@ @<Copy verbatim or string...@>=
+app_repl(b);
+oldb=b;
+@<Write |" <"| (|#ifdef TRACE_MACROS|)@>;
+while((b=*cur_byte++)!=oldb) {
+@<Trace scansion of character |b| (|#ifdef TRACE_MACROS|)@>;
+ app_repl(b);
+ if (cur_byte>=cur_end)
+ confusion("string or constant didn't end in token list");
+}
+@<Write |">"| (|#ifdef TRACE_MACROS|)@>;
+
+
+
+@ @<Write |" <"| (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if(tracing>2) printf(" <");
+#endif TRACE_MACROS
+@ @<Trace scansion of character |b| (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) printf("%c",b);
+#endif TRACE_MACROS
+@ @<Write |">"| (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if(tracing>2) printf(">");
+#endif TRACE_MACROS
+@ @<Trace parameter scansion (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf (" <#%d=",b); print_id(name_ptr-b); printf("=nd[%d]>",
+ name_ptr-b-name_dir);
+ }
+#endif TRACE_MACROS
+
+@ @<Trace scansion of token in |b| (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ int c;
+ printf (" <");
+ c=(b-@'200)*@'400+*cur_byte;
+ switch (c/@'24000) {
+ case 0: print_id(name_dir+c);
+ printf(" =nd[%d]",c);
+ break;
+ case 1: printf("MODULE"); break;
+ default: printf("CONTEXT"); break;
+ }
+ printf(">");
+}
+#endif TRACE_MACROS
+
+@ @<Trace scansion of ordinary token in |b|@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf (" <");
+ if (@'37<b && b<@'177) printf("%c",b);
+ printf(">");
+}
+#endif TRACE_MACROS
+
+@ @<Trace scanning for stack (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf ("\nScanning #%d...", number_of_parameters+1);
+ }
+#endif TRACE_MACROS
+@ @<Trace stacking the parameter (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>1) {
+ printf ("\nStacked "); print_id(parm_ptr-1);
+ printf ("=nd[%d]", parm_ptr-1-name_dir);
+ }
+#endif TRACE_MACROS
+
+@ The user may have forgotten to give any \cee\ text for a module name,
+or the \cee\ text may have been associated with a different name by mistake.
+
+@<Expand module |a-...@>=
+ a-=@'24000;
+ if ((a+name_dir)->equiv!=(ASCII *)text_info) push_level(a+name_dir);
+ else if (a!=0) {
+ printf("\n! Not present: <"); print_id(a+name_dir); err_print(">");
+@.Not present: <section name>@>
+ }
+ goto restart;
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there is one further consideration that has a nontrivial
+effect on \.{TANGLE}'s algorithms. Namely,
+we want to make sure that the output has spaces and line breaks in
+the right places (e.g., not in the middle of a string or a constant or an
+identifier, not at a `\.{@@\&}' position
+where quantities are being joined together, and certainly after a \.=
+because the C compiler thinks \.{=-} is ambiguous).
+
+The output process can be in one of following states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |verbatim| means we're copying only character tokens, and
+that they are to be output exactly as stored. This is the case during
+strings, verbatim constructions and numerical constants.
+
+\yskip\hang |misc| means none of the above.
+
+\yskip Furthermore, if the variable |protect| is positive, new-lines
+are preceded by a `\.\\'.% note this for /*spider*/
+
+@d misc = 0 /* ``normal'' state */
+@d num_or_id = 1 /* state associated with numbers and identifiers */
+@d unbreakable = 3 /* state associated with \.{@@\&} */
+@d verbatim = 4 /* state in the middle of a string */
+
+@<Global...@>=
+eight_bits out_state; /* current status of partial output */
+boolean protect; /* current status of partial output */
+
+@ Here is a routine that is invoked when we want to output the current line.
+During the output process, |cur_line| equals the number of the next line
+to be output.
+
+@u flush_buffer() /* writes one line to output file */
+{
+ C_putc('\n');
+ if (cur_line % 100 == 0) {
+ printf(".");
+ if (cur_line % 500 == 0) printf("%d",cur_line);
+ update_terminal; /* progress report */
+ }
+ cur_line++;
+}
+
+@* The big output switch. Here then is the routine that does the
+output.
+We have made some modifications to \.{TANGLE} so it will write output
+on multiple files.
+We do this very simply: if a module name is introduced by \.{@@(}
+instead of \.{@@<}, we treat it as the name of a file.
+All these special modules are saved on a stack, |output_files|.
+We write them out after we've done the unnamed module.
+
+@d max_files = 256
+@<Glob...@>=
+name_pointer output_files[max_files];
+name_pointer *cur_out_file, *end_output_files, *an_output_file;
+char cur_module_char; /* is it |'<'| or |'('| */
+char output_file_name[longest_name]; /* name of the file */
+
+@ We make |end_output_files| point jsut beyond the end of
+|output_files|.
+|cur_out_file| starts out there. Every time we see a new file, we
+decrement |cur_out_file| and then write it in.
+@<Set initial...@>=
+cur_out_file=end_output_files=output_files+max_files;
+
+@ @<If it's not there, add |cur_module| to the output file stack, or
+complain we're out of room@>=
+{
+if (cur_out_file>output_files) {
+ for (an_output_file=cur_out_file;
+ an_output_file<end_output_files; an_output_file++)
+ if (*an_output_file==cur_module) break;
+ if (an_output_file==end_output_files)
+ *--cur_out_file=cur_module;
+} else {
+ overflow("output files");
+}
+}
+
+@ Here is the output switch, then...
+
+@u
+phase_two () {
+ cur_line=1;
+ if (text_info->text_link==0) {
+ if(end_output_files==cur_out_file) {
+ printf("\n! No program text was specified."); mark_harmless;
+@.No output was specified@>
+ }
+ } else {
+ printf("\nWriting the output files: (%s)",C_file_name); update_terminal;
+ @<Initialize the output stacks@>;
+ while (stack_ptr>stack) get_output();
+ flush_buffer();
+ }
+ if (end_output_files>cur_out_file) {
+ if(text_info->text_link==0) {
+ printf("\nWriting the output files: "); update_terminal;
+ }
+ @<Write all the named output files@>@;
+ }
+ printf("\nDone.");
+}
+
+@ To write the named output files, we proceed as for the unnamed
+module.
+The only subtlety is that we have to open each one.
+@<Write all the named output files@>=
+for (an_output_file=end_output_files; an_output_file>cur_out_file;) {
+ an_output_file--;
+ strncpy(output_file_name,(*an_output_file)->byte_start, longest_name);
+ output_file_name[length(*an_output_file)]='\0';
+ fclose(C_file);
+ C_file=fopen(output_file_name,"w");
+ if (C_file == NULL) {
+ fatal("! Cannot open output file:",output_file_name)@;
+ } else {
+ printf(" (%s)",output_file_name); update_terminal;
+ }
+ stack_ptr=stack+1;
+ cur_name= (*an_output_file);
+ cur_repl= (text_pointer) cur_name->equiv_or_xref;
+ cur_byte=cur_repl->tok_start;
+ cur_end=(cur_repl+1)->tok_start;
+ cur_mod=0;
+ while (stack_ptr > stack) get_output();
+ flush_buffer();
+}
+
+
+
+@ A many-way switch is used to send the output:
+
+@u out_char(cur_char)
+eight_bits cur_char;
+{
+ ASCII *j; /* pointer into |byte_mem| */
+ @<Trace |cur_char| (|#ifdef TRACE_MACROS|)@>;
+ switch (cur_char) {
+ case @`\n': if (protect) C_putc(' '); /*spider*/
+ if (protect || out_state==verbatim) C_putc('\\'); /*spider*/
+ /*spider*/ /*may need to escape newlines*/
+ flush_buffer(); if (out_state!=verbatim) out_state=misc; break;
+ @/@t\4@>@<Case of an identifier@>;
+ @/@t\4@>@<Case of a module number@>;
+ @<Cases for tokens to be output@>@;
+ case join: out_state=unbreakable; break;
+ case constant: if (out_state==verbatim) {
+ out_state=num_or_id; break;
+ }
+ if(out_state==num_or_id) C_putc(' '); out_state=verbatim; break;
+ case string: if (out_state==verbatim) out_state=misc;
+ else out_state=verbatim; break;
+ default: C_putc(cur_char); if (out_state!=verbatim) out_state=misc;
+ break;
+ }
+}
+
+@ @<Trace |cur_char| (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ switch(cur_char) {
+ case @`\n': printf(" [\\n]"); break;
+ case string:
+ printf( "[STRING]"); break;
+ case join:
+ printf( "[JOIN]"); break;
+ case constant:
+ printf( "[CONSTANT]"); break;
+ case identifier:
+ printf (" ["); print_id(cur_val+name_dir); printf("]");
+ break;
+ case module_number:
+ if (cur_val>0) {
+ printf(" [%d:]", cur_val);
+ } else if(cur_val<0) {
+ printf(" [:%d]", - cur_val);
+ } else {
+ printf( "[LINE NUMBER]");
+ }
+ break;
+
+ default:
+ if (@'37<cur_char && cur_char < @'177) {
+ printf (" [%c]", cur_char);
+ } else {
+ printf(" [\\%3o]",cur_char);
+ }
+ }
+}
+#endif TRACE_MACROS
+
+
+
+
+@ @<Case of an identifier@>=
+case identifier:
+ if (out_state==num_or_id) C_putc(' ');
+ for (j=(cur_val+name_dir)->byte_start; j<(name_dir+cur_val+1)->byte_start;
+ j++) C_putc(*j);
+ out_state=num_or_id; break;
+
+@ @<Case of a mod...@>=
+case module_number:
+ if (cur_val>0) {
+ C_printf("%s",begin_comment_string);
+ C_printf("%d:",cur_val);
+ C_printf("%s",end_comment_string);
+ } else if(cur_val<0) {
+ C_printf("%s",begin_comment_string);
+ C_printf(":%d",-cur_val);
+ C_printf("%s",end_comment_string);
+ } else {
+ sixteen_bits a;
+ a=@'400* *cur_byte++;
+ a+=*cur_byte++; /* gets the line number */
+ C_printf("\n%s",sharp_line_open);
+ C_printf(" %d \"",a);
+ cur_val=*cur_byte++;
+ cur_val=@'400*(cur_val-@'200)+ *cur_byte++; /* points to the file name */
+ for (j=(cur_val+name_dir)->byte_start; j<(name_dir+cur_val+1)->byte_start;
+ j++) C_putc(*j);
+ C_printf("\"%s\n",sharp_line_close);
+ }
+ break;
+
+@i outtoks.web
+@* Introduction to the input phase.
+We have now seen that \.{TANGLE} will be able to output the full
+\cee\ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \cee\ text; the other two are used to scan rapidly past
+\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \cee\ comment.
+
+@ Control codes in \.{WEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{WEAVE},
+so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into
+internal code numbers by the |control_code| table below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore = 0 /* control code of no interest to \.{TANGLE} */
+@d octal = @'5
+@d hex = @'6
+@d trace = @'370
+@d ascii_constant = @'371 /* control code for `\.{@@`}' */
+@d control_text = @'372 /* control code for `\.{@@t}', `\.{@@\^}', etc. */
+@d format = @'373 /* control code for `\.{@@f}' */
+@d definition = @'374 /* control code for `\.{@@d}' */
+@d begin_unnamed = @'375 /* control code for `\.{@@u}' */
+@d module_name = @'376 /* control code for `\.{@@<}' */
+@d new_module = @'377 /* control code for `\.{@@\ }' and `\.{@@*}' */
+
+@<Global...@>=
+eight_bits ccode[128]; /* meaning of a char following \.{@@} */
+
+@ @<Set ini...@>= {
+ int c; /* must be |int| so the |for| loop will end */
+ for (c=0; c<=127; c++) ccode[c]=ignore;
+ ccode[' ']=ccode[tab_mark]=ccode['*']=new_module;
+ ccode ['@@'] = '@@';
+ ccode['=']=string;
+ ccode['d']=ccode['D']=definition;
+ ccode['f']=ccode['F']=format;
+ ccode['c']=ccode['C']=begin_unnamed;
+ ccode['u']=ccode['U']=begin_unnamed;
+ ccode['^']=ccode[':']=ccode['.']=ccode['t']=ccode['T']=control_text;
+ ccode['&']=join;
+ ccode['<']=ccode['(']=module_name;
+ ccode['`']=ascii_constant;
+ ccode['\'']=octal;
+ ccode['"']=hex;
+/*Now adjust for |at_sign|... if it is @@, we have no-op followed by quoting */
+/* ... but if it is other, say \#, then \#@@ replaces @@\#, and \#\#
+ quotes itself*/
+ccode['@@']=ccode[at_sign];
+ccode[at_sign]=at_sign;
+
+#ifdef DEBUG
+ccode['0']=ccode['1']=ccode['2']=ccode['3']=ccode['4']=trace;
+#endif DEBUG
+
+}
+
+@ We may want some sort of tracing facility:
+@<Global variables@>=short tracing;
+@ @<Set initial...@>=tracing=0;
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@u eight_bits skip_ahead() /* skip to next control code */
+{
+ eight_bits c; /* control code found */
+ while (1) {
+ if (loc>limit && (get_line()==0)) return(new_module);
+ *(limit+1)=at_sign;
+ while (*loc!=at_sign) loc++;
+ if (loc<=limit) {
+ loc++; c=ccode[*loc];
+#ifdef DEBUG
+ if (c==trace) {
+ tracing=*loc-@`0'; c=ignore;
+ }
+#endif DEBUG
+ loc++;
+ if (c!=ignore || *(loc-1)=='>') return(c);
+ }
+ }
+}
+
+@ The |skip_comment| procedure reads through the input at somewhat high
+speed until finding the end-comment token \.{*/} or a new-line, in which
+case |skip_comment| will be called again by |get_next|, since the
+comment is not finished. This is done so that the each newline in the
+C part of a module is copied to the output; otherwise the \&{\#line}
+commands inserted into the C file by the output routines become useless.
+If it comes to the end of the module it prints an error message.
+
+@<Global...@>=
+boolean comment_continues=0; /* are we scanning a comment? */
+
+@ @u
+skip_comment() /* skips over comments */
+{
+ ASCII c; /* current character */
+ if (comments_end_with_newline) {
+ get_line();
+ return (comment_continues=0);
+ } else {
+ while (1) {/*spider*/ /* fix this to recognize end ok */
+ if (loc>limit)
+ if(get_line()) return(comment_continues=1);
+ else{
+ err_print("! Input ended in mid-comment");
+@.Input ended in mid-comment@>
+ return(comment_continues=0);
+ }
+ c=*(loc++);
+ @<Recognize comment end starting at |loc-1|@>@;
+ if (c==at_sign) {
+ if (ccode[*loc]==new_module) {
+ err_print("! Section name ended in mid-comment"); loc--;
+@.Section name ended in mid-comment@>
+ return(comment_continues=0);
+ }
+ else loc++;
+ }
+ }
+ }
+}
+@* Inputting the next token.
+@d constant = @'3
+@<Global...@>=
+name_pointer cur_module; /* name of module just scanned */
+
+@ @<Include...@>=
+#include "ctype.h" /* definition of |isalpha|, |isdigit| and so on */
+
+@ As one might expect, |get_next| consists mostly of a big switch
+that branches to the various special cases that can arise.
+
+@u eight_bits get_next() /* produces the next input token */
+{
+ eight_bits c; /* the current character */
+ while (1) {
+ if (loc>limit) {
+ if (get_line()==0) return(new_module);
+ else if (print_where) {
+ print_where=0;
+ @<Insert the line number into |tok_mem|@>;
+ }
+ else return (@`\n');
+ }
+ c=*loc;
+ if (comment_continues) {
+ skip_comment(); /* scan to end of comment or newline */
+ if (comment_continues || comments_end_with_newline) return(@`\n');
+ else continue;
+ }
+ @<See a comment starting at |loc| and skip it@>@;
+ loc++;
+ if (isdigit(c) || c=='\\' || c=='.') @<Get a constant@>@;/*spider*/
+ else if (isalpha(c) || c=='_' || c=='$') @<Get an identifier@>@;/*spider*/
+ else if (c=='\'' || c=='\"') @<Get a string@>@;/*spider*/
+ else if (c==at_sign) @<Get control code and possible module name@>@;
+ else if (c==' ' || c==tab_mark) {
+ continue; /* ignore spaces and tabs */
+ }
+ mistake: @<Compress two-symbol operator@>@;
+ return(c);
+ }
+}
+
+@ @<Get an identifier@>= {/*spider*/
+ id_first=--loc;
+ while (isalpha(*++loc) || isdigit(*loc) || *loc=='_');
+ if (*loc=='$') while (isdigit(*++loc)||*loc=='$');
+ /* make room for \$\$ and \$nnn suffixes */
+ id_loc=loc; return(identifier);
+}
+
+@ @<Get a constant@>= {/*spider*/
+ id_first=loc-1;
+ if (*id_first=='.' && !isdigit(*loc)) goto mistake; /* not a constant */
+ if (*id_first=='\\') while (isdigit(*loc)) loc++; /* octal constant */
+ else {
+ if (*id_first=='0') {
+ if (*loc=='x' || *loc=='X') { /* hex constant */
+ loc++; while (isxdigit(*loc)) loc++; goto found;
+ }
+ }
+ while (isdigit(*loc)) loc++;
+ if (*loc=='.') {
+ loc++;
+ while (isdigit(*loc)) loc++;
+ }
+ if (*loc=='e' || *loc=='E') { /* float constant */
+ if (*++loc=='+' || *loc=='-') loc++;
+ while (isdigit(*loc)) loc++;
+ }
+ }
+ found:
+ id_loc=loc;
+ return(constant);
+}
+
+@ \cee\ strings and character constants, delimited by double and single
+quotes, respectively, can contain newlines or instances of their own
+delimiters if they are protected by a backslash. We follow this
+convention, but do not allow the string to be longer than |longest_name|.
+
+@<Get a string@>= {/*spider*/
+ ASCII delim = c; /* what started the string */
+@#
+/* if it's not a single-character literal, it's a tick mark or an |at_sign| */
+ if (delim=='\'' && (loc+1>=limit ||
+ (*loc != '\\' && *loc!=at_sign && loc[1]!='\'') ||
+ (*loc=='\\' && (loc+2>=limit||loc[2]!='\'')) ||
+ (*loc==at_sign &&
+ (loc+2>=limit||loc[1]!=at_sign||loc[2]!='\''))
+ )) goto mistake;
+ id_first = mod_text+1;
+ id_loc = mod_text; *++id_loc=delim;
+ while (1) {
+ if (loc>=limit) {
+ if(*(limit-1)!='\\') {
+ err_print("! String didn't end"); loc=limit; break;
+@.String didn't end@>
+ }
+ if(get_line()==0) {
+ err_print("! Input ended in middle of string"); loc=buffer; break;
+@.Input ended in middle of string@>
+ }
+ else if (++id_loc<=mod_text_end) *id_loc=@`\n'; /* will print as
+ \.{"\\\\\\n"} */
+ }
+ if ((c=*loc++)==delim) {
+ if (++id_loc<=mod_text_end) *id_loc=c;
+ break;
+ }
+ if (c=='\\') {
+ if (loc>=limit) continue;
+ if (++id_loc<=mod_text_end) *id_loc = '\\';
+ c=*loc++;
+ }
+ if (++id_loc<=mod_text_end) *id_loc=c;
+ }
+ if (id_loc>=mod_text_end) {
+ printf("\n! String too long: ");
+@.String too long@>
+ ASCII_write(mod_text+1,25);
+ printf("..."); mark_error;
+ }
+ id_loc++;
+ return(string);
+}
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>= {
+ c=ccode[*loc++];
+ switch(c) {
+ case ignore: continue;
+ case control_text: while ((c=skip_ahead())==at_sign);
+ /* only \.{@@@@} and \.{@@>} are expected */
+ if (*(loc-1)!='>') err_print("! Improper @@ within control text");
+@.Improper {\AT!} within control text@>
+ continue;
+ case module_name:
+ cur_module_char=*(loc-1);
+ @<Scan the module name and make |cur_module| point to it@>;
+ case string: @<Scan a verbatim string@>;
+#ifdef DEBUG
+ case trace: tracing=*(loc-1)-'0'; continue;
+#endif DEBUG
+ case ascii_constant: @<Scan an ASCII constant@>;
+ case octal: @<Scan an octal constant@>;
+ case hex: @<Scan a hex constant@>;
+ default: return(c);
+ }
+}
+
+@ @<Scan an ASCII...@>=/*spider*/
+ id_first=loc;
+ if (*loc=='\\') loc++;
+ while (*loc!='\'') {
+ loc++;
+ if (loc>limit) {
+ err_print("! String didn't end"); loc=limit-1; break;
+ }
+ }
+ loc++;
+ return(ascii_constant);
+
+@ @<Scan an octal constant@>= {
+ id_first=loc;
+ while ('0'<=*loc && *loc<'8') loc++;
+ id_loc=loc;
+ return(octal);
+}
+
+@ @<Scan a hex constant@>= {
+ id_first=loc;
+ while (isxdigit(*loc)) loc++;
+ id_loc=loc;
+ return(hex);
+}
+
+
+@ @<Scan the module name...@>= {
+ ASCII *k; /* pointer into |mod_text| */
+ @<Put module name into |mod_text|@>;
+ if (k-mod_text>3 && strncmp(k-2,"...",3)==0) cur_module=prefix_lookup(mod_text+1,k-3);
+ else cur_module=mod_lookup(mod_text+1,k);
+ if (cur_module_char=='(') {
+ @<If it's not there, add |cur_module| to the output file stack, or
+ complain we're out of room@>@;
+ }
+ return(module_name);
+}
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]=' '| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]=' ';
+
+@ @<Put module name...@>=
+k=mod_text;
+while (1) {
+ if (loc>limit && get_line()==0) {
+ err_print("! Input ended in section name");
+@.Input ended in section name@>
+ loc=buffer+1; break;
+ }
+ c=*loc;
+ @<If end of name, |break|@>;
+ loc++; if (k<mod_text_end) k++;
+ if (c==' ' || c==tab_mark) {
+ c=' '; if (*(k-1)==' ') k--;
+ }
+*k=c;
+}
+if (k>=mod_text_end) {
+ printf("\n! Section name too long: ");
+@.Section name too long@>
+ ASCII_write(mod_text+1,25);
+ printf("..."); mark_harmless;
+}
+if (*k==' ' && k>mod_text) k--;
+
+@ @<If end of name,...@>=
+if (c==at_sign) {
+ c=*(loc+1);
+ if (c=='>') {
+ loc+=2; break;
+ }
+ if (ccode[c]==new_module) {
+ err_print("! Section name didn't end"); break;
+@.Section name didn't end@>
+ }
+ *(++k)=at_sign; loc++; /* now |c==*loc| again */
+}
+
+@ At the present point in the program we
+have |*(loc-1)=string|; we set |id_first| to the beginning
+of the string itself, and |id_loc| to its ending-plus-one location in the
+buffer. We also set |loc| to the position just after the ending delimiter.
+
+@<Scan a verbatim string@>= {
+ id_first=loc++; *(limit+1)=at_sign; *(limit+2)='>';
+ while (*loc!=at_sign || *(loc+1)!='>') loc++;
+ if (loc>=limit) err_print("! Verbatim string didn't end");
+@.Verbatim string didn't end@>
+ id_loc=loc; loc+=2;
+ return(string);
+}
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to macros and
+\cee\ texts of a module are almost identical; the only differences are that
+
+\yskip \item{a)}Module names are not allowed in macros;
+in fact, the appearance of a module name terminates such macros and denotes
+the name of the current module.
+
+\item{b)}The symbols \.{@@d} and \.{@@f} and \.{@@u} are not allowed after
+module names, while they terminate macro definitions.
+
+\yskip Therefore there is a single procedure |scan_repl| whose parameter
+|t| specifies either |macro| or |module_name|. After |scan_repl| has
+acted, |cur_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@d app_repl(c) = {if (tok_ptr==tok_mem_end) overflow("token"); *tok_ptr++=c;}
+
+@<Global...@>=
+text_pointer cur_text; /* replacement text formed by |scan_repl| */
+eight_bits next_control;
+
+@ @u scan_repl(t) /* creates a replacement text */
+eight_bits t;
+{
+ sixteen_bits a; /* the current token */
+ int set_print_where;
+ if (t==module_name) {@<Insert the line number into |tok_mem|@>;}
+ /* avoid inserting line number in macro replacement texts */
+ /* |print_where| is both tested and set in |get_next| */
+ while (1) {
+ if (t==macro) {
+ print_where = 0;
+ }
+ a=get_next();
+ if (t==macro) {
+ set_print_where = print_where;
+ }
+ switch (a) {
+ @<In cases that |a| is a non-ASCII token (|identifier|,
+ |module_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>@;
+ default: app_repl(a); /* store |a| in |tok_mem| */
+ }
+ }
+ done: next_control=(eight_bits) a;
+ if (text_ptr>text_info_end) overflow("text");
+ if (t==macro) {
+ @<Strip trailing newlines from the replacement text@>;
+ }
+ cur_text=text_ptr; (++text_ptr)->tok_start=tok_ptr;
+ print_where = set_print_where;
+}
+
+@ We don't ever want a macro replacement text to end with newline,
+but for readability of the {\tt WEB} source
+we usually want the last token in a macro definition
+to be a newline token.
+We can't just look for |@`\n'| at the end of the token list, because
+that might be the second half of a two-byte token, in which case it
+certainly {\em wouldn't} be a newline!
+So we look for a two-byte token (|*tok_ptr>=@'200|); as soon as we find one
+we've eliminated all trailing newlines.
+As long as we keep finding one-byte tokens, we drop trailing newlines
+as they come along.
+@<Strip trailing newlines...@>=
+tok_ptr -= 2;
+while (*tok_ptr<@'200 && *(tok_ptr+1)==@`\n') tok_ptr--;
+tok_ptr += 2;
+
+@ We use macros with zero or more parameters, and we give the parameters names.
+In order to scan a macro definition, we need to be able to substitute
+special markers for the parameter names.
+We {\em don't} put the parameter names in the hash table, because they're
+strictly temporary.
+Instead we keep them in temporary storage:
+We allow macros to have up to 32 parameters using 256 text chars.
+
+@d max_param_name_texts = 256
+@d max_param_names = 32
+@<Global variables@>=
+ASCII param_name_texts[max_param_name_texts];
+ASCII *param_name_texts_end = param_name_texts+max_param_name_texts;
+ASCII * param_names[max_param_names]; /* pointers into |param_name_texts| */
+short next_param_name; /* first free spot in |param_names| */
+ASCII * next_param_name_text; /* first free spot in |param_name_texts| */
+
+@ @<Initialize the parameter name area@>=
+next_param_name=0;
+next_param_name_text=param_name_texts;
+param_names[next_param_name]=next_param_name_text;
+
+@ @<Set initial values@>=@<Initialize the parameter name area@>;
+
+@ @<Add identifier to parameter name list@>=
+@<Check for parameter name overflow@>;
+while (id_first<id_loc)
+ *next_param_name_text++=*id_first++;
+param_names[++next_param_name]=next_param_name_text;
+
+@ @<Check for parameter name overflow@>=
+if (next_param_name==max_param_names)
+ overflow ("parameter names");
+if (id_loc - id_first >
+ param_name_texts_end - next_param_name_text)
+ overflow ("parameter name texts");
+
+
+@ The function |parameter_number(first,loc)| returns |0| if the identifier
+is not a parameter, and the number of the parameter if it is a parameter.
+This is not the parameter number we'll store, because for storage we
+want the {\em last} parameter to be {\tt \#1}, the penultimate to
+be {\tt \#2}, and so on.
+This means we have to know the number of parameters only when constructing
+the replacement text, not when scanning the replacement text.
+@u
+int parameter_number(first, loc)
+ ASCII *first, *loc;
+{
+ ASCII *f, *p;
+ int n;
+ for (n=0;n<next_param_name;n++) {
+ if (loc-first==param_names[n+1]-param_names[n]) {
+ /* lengths match */
+ for(f=first,p=param_names[n];f<loc;)
+ if (*f++!=*p++) goto nomatch;
+ return n+1; /* matched parameter */
+ }
+ nomatch: continue; /* need |continue| to avoid syntax error! */
+ }
+ return 0; /* never matched anything */
+}
+
+
+@ While scanning the macro name and parameter list, we ignore newlines.
+We initialize the parameter name area at the beginning, and again
+after scanning each replacement text.
+This makes sure we have an empty parameter name area when scanning the
+replacement text for a module.
+
+@<Scan a macro definition@>=
+@<Set |next_control| to the first non-newline token@>@;
+@<Take the macro name in |next_control|, put it in the hash table.
+ and set |p| to its entry in |name_dir|@>;
+@<Scan the parameter list (if any),
+ and set |next_control| to the non-newline
+ token following the parameter list@>;
+if (next_control!= @`=') {
+ err_print("! You must put an = sign before the macro replacement text");
+ @<Quit scanning the macro definition@>;
+}
+@<Trace macro name (|#ifdef TRACE_MACROS|)@>;
+app_repl(next_param_name); /* store number of parameters in |tok_mem| */
+scan_repl(macro);
+p->equiv=(ASCII *)cur_text;
+@<Trace equivalent text (|#ifdef TRACE_MACROS|)@>;
+@<Initialize the parameter name area@>;
+
+@ @<Trace macro name (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>1) {
+ printf("\nScanning definition of macro "); print_id(p);
+ }
+#endif TRACE_MACROS
+
+@ @<Trace equivalent text (|#ifdef TRACE_MACROS|)@>=
+#ifdef TRACE_MACROS
+if (tracing>2) {
+ printf("\nMacro "); print_id(p);
+ printf("'s replacement text is in text_info[%d]", cur_text-text_info);
+ }
+#endif TRACE_MACROS
+
+
+@ @<Scan the parameter list (if any), and set |next_control| to the
+ non-newline token
+ following the parameter list@>=
+@<Set |next_control| to the first non-newline token@>@;
+if (next_control==@`(') {
+ do {
+ @<Get a parameter name@>;
+ @<Set |next_control| to the first non-newline token@>@;
+ } while (next_control==@`,');
+ if (next_control != @`)') {
+ err_print("! Macro parameter list must end with )");
+ @<Quit scanning the macro definition@>;
+ }
+ next_control=get_next(); /* first token following parameter list */
+}
+
+
+@ @<Take the macro name in |next_control|...@>=
+if (next_control!=identifier) {
+ err_print("! Macro name must be an identifier");
+@.Macro name must be an identifier@>
+ @<Quit scanning the macro definition@>;
+} else {
+ p = id_lookup(id_first,id_loc,macro);
+ if (p->ilk!=macro) {
+#ifdef WARN_USE_BEFORE_DEF
+ printf("\n! Warning: macro name ");
+ print_id(p);
+ printf(" was used before it was defined");
+ mark_harmless;
+#endif WARN_USE_BEFORE_DEF
+ p->ilk=macro;
+ } else if (p+1!=name_ptr) {
+ err_print ("! Macro name is multiply defined: ");
+ }
+}
+
+@ @<Get a parameter name@>=
+@<Set |next_control| to the first non-newline token@>;
+if (next_control!=identifier) {
+ err_print("! Macro parameter name not an identifier");
+@.Macro parameter name...@>
+ @<Quit scanning the macro definition@>;
+} else {
+ if (parameter_number(id_first,id_loc)!=0) {
+ err_print("! Duplicate parameters in macro definition");
+@.Duplicate parameters...@>
+ @<Quit scanning the macro definition@>;
+ } else {
+ @<Add identifier to parameter name list@>;
+ }
+}
+
+
+@ @<Set |next_control| to the first non-newline token@>=
+while ((next_control=get_next())==@`\n');
+
+@ We modify this from the old tangle:
+
+@<In cases that |a| is a non-ASCII token (|identifier|,
+ |module_name|, etc.), either process it and change |a| to a byte
+ that should be stored, or |continue| if |a| should be ignored,
+ or |goto done| if |a| signals the end of this replacement text@>=
+case identifier:
+ { short n;
+ if ((n=parameter_number(id_first,id_loc))!=0) {
+#ifdef TRACE_MACROS
+if(tracing>1) {
+ printf("\nIdentified "); ASCII_write(id_first,id_loc-id_first);
+ printf(" as parameter number %d (%d from back)",n,next_param_name-n+1);
+ }
+#endif TRACE_MACROS
+ app_repl(param);
+ app_repl(next_param_name-n+1); /* reverses numbering */
+ } else { /* not a parameter */
+ a=id_lookup(id_first,id_loc,normal)-name_dir;
+ app_repl((a / @'400)+@'200); app_repl(a % @'400);
+ }
+ }
+ break;
+case module_name: if (t!=module_name) goto done;
+ else {
+ @<Was an |at_sign| missed here?@>;
+ a=cur_module-name_dir;
+ app_repl((a / @'400)+@'250);
+ app_repl(a % @'400);
+ @<Insert the line number into |tok_mem|@>; break;
+ }
+case constant: case string:
+ @<Copy a string or verbatim construction or numerical constant@>;
+case ascii_constant:
+ @<Copy an ASCII constant@>;
+case octal:
+ @<Copy an octal constant@>; break;
+case hex:
+ @<Copy a hex constant@>; break;
+case @`\n':
+#ifdef NEWLINES_IN_MACROS
+ app_repl(a);
+#else
+ if (t==macro) continue;
+ else app_repl(a);
+#endif NEWLINES_IN_MACROS
+ break;
+case definition: case format: case begin_unnamed:
+ if (t!=module_name) goto done;
+ else {
+ err_print("! @@d, @@f and @@u are ignored in C text"); continue;
+@.{\AT!}d, {\AT!}f and {\AT!}u are ignored in C text@>
+ }
+case new_module: goto done;
+
+@ Here is the code for the line number: first a |sixteen_bits| equal
+to |@'150000|; then, if we're dealing with the change file, the line
+number plus |@'100000|; or, if we're dealing with the web file, the
+line number; or, if we're dealing with an include file, the number 0,
+then the line number, followed by the number of characters in the file
+name and the file name.
+
+@<Insert the line...@>=
+store_two_bytes(@'150000);
+if (changing) id_first=change_file_name;
+else id_first=cur_file_name;
+id_loc=id_first+strlen(id_first);
+if (changing) store_two_bytes((sixteen_bits)change_line);
+else store_two_bytes((sixteen_bits)cur_line);
+{int a=id_lookup(id_first,id_loc,normal)-name_dir; app_repl((a / @'400)+@'200);
+ app_repl(a % @'400);}
+
+@ @<Was an |at_sign|...@>= {
+ ASCII *try_loc=loc;
+ while (*try_loc==' ' && try_loc<limit) try_loc++;
+ if (*try_loc=='+' && try_loc<limit) try_loc++;
+ while (*try_loc==' ' && try_loc<limit) try_loc++;
+ if (*try_loc=='=') err_print ("! Nested named modules. Missing @@?");
+@.Nested named modules@>
+}
+
+@ @<Copy a string...@>=
+ app_repl(a); /* |string| or |constant| */
+ while (id_first < id_loc) { /* simplify \.{@@@@} pairs */
+ if (*id_first==at_sign) id_first++;
+ app_repl(*id_first++);
+ }
+ app_repl(a); break;
+
+@ @<Copy an ASCII constant@>= {
+ int c;
+ if (*id_first==at_sign) {
+ c=xchr[*id_first++];
+ if (*id_first!=at_sign) err_print("! Double @@ within string");
+ }
+ else if (*id_first=='\\') {
+ id_first++;
+ switch (*id_first) {
+ case 't':c=@`\t';break;
+ case 'n':c=@`\n';break;
+ case 'b':c=@`\b';break;
+ case '0':c=@`\0';break;
+ case '\\':c=@`\\';break;
+ default: err_print("! Unrecognized escape sequence");
+ }
+ }
+ else c=xchr[*id_first];
+ app_repl(constant);
+/* we don't want octal; we want decimal */
+ /* we know |c<=255| */
+ app_decimal((long)c);
+ app_repl(constant);
+}
+break;
+
+@ Paranoia to work on any 32 bit integer machine...
+@<Copy an octal constant@>= {
+long sum=0;
+while (id_first<id_loc) {
+ sum = 8*sum + *id_first++ - '0';
+ if (sum > @"04000000) err_print("! Octal constant exceeds @@\"04000000");
+ }
+app_repl(constant);
+app_decimal(sum);
+app_repl(constant);
+}
+
+@ @<Copy a hex constant@>= {
+long sum=0;
+while (id_first<id_loc) {
+ sum = 16*sum +
+ (isdigit(*id_first)
+ ? *id_first - '0'
+ : isupper(*id_first)
+ ? *id_first - 'A' + 10
+ : *id_first - 'a' + 10
+ );
+ id_first++;
+ if (sum > @"04000000) err_print("! Hex constant exceeds @@\"04000000");
+ }
+app_repl(constant);
+app_decimal(sum);
+app_repl(constant);
+}
+
+@ This function prints out a decimal constant using |app_repl|.
+@u
+app_decimal(c)
+ long c; /* on entry require |c>=0| */
+{long power;
+ if (c==0) {app_repl('0'); return;}
+ if (c<0) /* should never happen */ {app_repl('-'); c = - c;}
+ for (power=1; c>=power; power *=10);
+ /* now |power/10<=c<power| */
+ for (power /=10; power>=1; power /=10) {
+ app_repl('0'+c/power); /* leading digit $>0$ */
+ c%=power;
+ /* invariant: original c = this c + printed string*power */
+ }
+ }
+
+
+
+@* Scanning a module.
+The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that module. It
+uses |module_count| to keep track of the current module number; with luck,
+\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules.
+
+@<Global...@>=
+extern sixteen_bits module_count; /* the current module number */
+
+@ The top level of |scan_module| is trivial.
+@u scan_module()
+{
+ name_pointer p; /* module name for the current module */
+ text_pointer q; /* text for the current module */
+ sixteen_bits a; /* token for left-hand side of definition */
+ module_count++;
+ if (*(loc-1)=='*') /* starred module */
+ printf("*%d",module_count); fflush(stdout);
+ @<Scan the definition part of the current module@>;
+ @<Scan the \cee\ part of the current module@>;
+}
+
+@ We define two kinds of ilks for identifiers: |normal| for ordinary
+identifiers, and |macro| for macros.
+@d normal = 0
+@d macro = 1
+@d simple = 2
+@<Scan the definition part...@>=
+next_control=0;
+while (1) {
+done_scanning:
+ while (next_control<=format)
+ if ((next_control=skip_ahead())==module_name) {
+ /* scan the module name too */
+ loc-=2; next_control=get_next();
+ }
+ if (next_control!=definition) break;
+ @<Scan a macro definition@>;
+ cur_text->text_link=0; /* |text_link=0| characterizes a macro */
+}
+
+@ We initialize the parameter name area at the beginning, and we re-initialize
+any time we have to punt a macro definition.
+This makes sure we have an empty parameter name area when scanning the
+replacement text for a module.
+@<Quit scanning the macro definition@>=
+@<Initialize the parameter name area@>;
+p->ilk=normal; /* turn off macro replacement and hope for the best */
+goto done_scanning;
+
+
+@ @<Scan the \cee...@>=
+switch (next_control) {
+ case begin_unnamed: p=name_dir; break;
+ case module_name: p=cur_module;
+ @<Check that |=| follows this module name, otherwise |return|@>;
+ break;
+ default: return;
+}
+@<Insert the module number into |tok_mem|@>;
+scan_repl(module_name); /* now |cur_text| points to the replacement text */
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Check that |=|...@>=
+while ((next_control=get_next())=='+'); /* allow optional `\.{+=}" */
+if (next_control!='=') {
+ err_print("! C text flushed, = sign is missing");
+@.C text flushed...@>
+ while ((next_control=skip_ahead()) != new_module);
+ return;
+}
+
+@ @<Insert the module number...@>=
+store_two_bytes((sixteen_bits)(@'150000+module_count)); /* |@'150000==@'320*@'400| */
+
+@ @<Update the data...@>=
+if (p==name_dir||p==0) { /* unnamed module, or bad module name */
+ (last_unnamed)->text_link=cur_text-text_info; last_unnamed=cur_text;
+}
+else if (p->equiv==(ASCII *)text_info) p->equiv=(ASCII *)cur_text;
+ /* first module of this name */
+else {
+ q=(text_pointer)p->equiv;
+ while (q->text_link<module_flag) q=q->text_link+text_info; /* find end of list */
+ q->text_link=cur_text-text_info;
+}
+cur_text->text_link=module_flag; /* mark this replacement text as a nonmacro */
+
+@ @u phase_one() {
+ phase=1;
+ module_count=0;
+ reset_input();
+ while ((next_control=skip_ahead())!=new_module);
+ while (!input_has_ended) scan_module();
+ check_complete();
+ phase=2;
+}
+
+@ @u print_stats() {
+ printf("\nMemory usage statistics:\n");
+ printf("%d names (out of %d)\n",name_ptr-name_dir,max_names);
+ printf("%d replacement texts (out of %d)\n",text_ptr-text_info,max_texts);
+ printf("%d bytes (out of %d)\n",byte_ptr-byte_mem,max_bytes);
+ printf("%d tokens (out of %d)\n",tok_ptr-tok_mem,max_toks);
+}
+
+@* Index.
+Here is a cross-reference table for the \.{TANGLE} processor.
+All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code'' are indexed here too.