ctangle.w

模拟器提供了一个简单易用的平台

@<Scan a verbatim string@>= {
  id_first=loc++; *(limit+1)='@@'; *(limit+2)='>';
  while (*loc!='@@' || *(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 section are almost identical; the only differences are that

\yskip \item{a)}Section names are not allowed in macros;
in fact, the appearance of a section name terminates such macros and denotes
the name of the current section.

\item{b)}The symbols \.{@@d} and \.{@@f} and \.{@@c} are not allowed after
section names, while they terminate macro definitions.

\item{c)}Spaces are inserted after right parentheses in macros, because the
ANSI \CEE/ preprocessor sometimes requires it.

\yskip Therefore there is a single procedure |scan_repl| whose parameter
|t| specifies either |macro| or |section_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 macro  0
@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;

@ @c
void
scan_repl(t) /* creates a replacement text */
eight_bits t;
{
  sixteen_bits a; /* the current token */
  if (t==section_name) {@<Insert the line number into |tok_mem|@>;}
  while (1) switch (a=get_next()) {
      @<In cases that |a| is a non-|char| token (|identifier|,
        |section_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 ')': app_repl(a);
        if (t==macro) app_repl(' ');
        break;
      default: app_repl(a); /* store |a| in |tok_mem| */
    }
  done: next_control=(eight_bits) a;
  if (text_ptr>text_info_end) overflow("text");
  cur_text=text_ptr; (++text_ptr)->tok_start=tok_ptr;
}

@ Here is the code for the line number: first a |sixteen_bits| equal
to |0150000|; then the numeric line number; then a pointer to the
file name.

@<Insert the line...@>=
store_two_bytes(0150000);
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,0)-name_dir; app_repl((a / 0400)+0200);
  app_repl(a % 0400);}

@ @<In cases that |a| is...@>=
case identifier: a=id_lookup(id_first,id_loc,0)-name_dir;
  app_repl((a / 0400)+0200);
  app_repl(a % 0400); break;
case section_name: if (t!=section_name) goto done;
  else {
    @<Was an `@@' missed here?@>;
    a=cur_section_name-name_dir;
    app_repl((a / 0400)+0250);
    app_repl(a % 0400);
    @<Insert the line number into |tok_mem|@>; break;
  }
case output_defs_code:
  a=output_defs_flag;
  app_repl((a / 0400)+0200);
  app_repl(a % 0400);
  @<Insert the line number into |tok_mem|@>; break;
case constant: case string:
  @<Copy a string or verbatim construction or numerical constant@>;
case ord:
  @<Copy an ASCII constant@>;
case definition: case format_code: case begin_C: if (t!=section_name) goto done;
  else {
    err_print("! @@d, @@f and @@c are ignored in C text"); continue;
@.@@d, @@f and @@c are ignored in C text@>
  }
case new_section: goto done;

@ @<Was an `@@'...@>= {
  char *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 ("! Missing `@@ ' before a named section");
@.Missing `@@ '...@>
  /* user who isn't defining a section should put newline after the name,
     as explained in the manual */
}

@ @<Copy a string...@>=
  app_repl(a); /* |string| or |constant| */
  while (id_first < id_loc) { /* simplify \.{@@@@} pairs */
    if (*id_first=='@@') {
      if (*(id_first+1)=='@@') id_first++;
      else err_print("! Double @@ should be used in string");
@.Double @@ should be used...@>
    }
    app_repl(*id_first++);
  }
  app_repl(a); break;

@ This section should be rewritten on machines that don't use ASCII
code internally.
@^ASCII code dependencies@>

@<Copy an ASCII constant@>= {
  int c=(eight_bits) *id_first;
  if (c=='\\') {
    c=*++id_first;
    if (c>='0' && c<='7') {
      c-='0';
      if (*(id_first+1)>='0' && *(id_first+1)<='7') {
        c=8*c+*(++id_first) - '0';
        if (*(id_first+1)>='0' && *(id_first+1)<='7' && c<32)
          c=8*c+*(++id_first)- '0';
      }
    }
    else switch (c) {
    case 't':c='\t';@+break;
    case 'n':c='\n';@+break;
    case 'b':c='\b';@+break;
    case 'f':c='\f';@+break;
    case 'v':c='\v';@+break;
    case 'r':c='\r';@+break;
    case 'a':c='\7';@+break;
    case '?':c='?';@+break;
    case 'x':
      if (xisdigit(*(id_first+1))) c=*(++id_first)-'0';
      else if (xisxdigit(*(id_first+1))) {
        ++id_first;
        c=toupper(*id_first)-'A'+10;
      }
      if (xisdigit(*(id_first+1))) c=16*c+*(++id_first)-'0';
      else if (xisxdigit(*(id_first+1))) {
        ++id_first;
        c=16*c+toupper(*id_first)-'A'+10;
      }
      break;
    case '\\':c='\\';@+break;
    case '\'':c='\'';@+break;
    case '\"':c='\"';@+break;
    default: err_print("! Unrecognized escape sequence");
@.Unrecognized escape sequence@>
    }
  }@/
  /* at this point |c| should have been converted to its ASCII code number */
  app_repl(constant);
  if (c>=100) app_repl('0'+c/100);
  if (c>=10) app_repl('0'+(c/10)%10);
  app_repl('0'+c%10);
  app_repl(constant);
}
break;

@* Scanning a section.
The |scan_section| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
sensed in the input, and it proceeds until the end of that section.  It
uses |section_count| to keep track of the current section number; with luck,
\.{CWEAVE} and \.{CTANGLE} will both assign the same numbers to sections.

@<Global...@>=
extern sixteen_bits section_count; /* the current section number */

@ The body of |scan_section| is a loop where we look for control codes
that are significant to \.{CTANGLE}: those
that delimit a definition, the \CEE/ part of a module, or a new module.

@c
void
scan_section()
{
  name_pointer p; /* section name for the current section */
  text_pointer q; /* text for the current section */
  sixteen_bits a; /* token for left-hand side of definition */
  section_count++; @+ no_where=1;
  if (*(loc-1)=='*' && show_progress) { /* starred section */
    printf("*%d",section_count); update_terminal;
  }
  next_control=0;
  while (1) {
    @<Skip ahead until |next_control| corresponds to \.{@@d}, \.{@@<},
      \.{@@\ } or the like@>;
    if (next_control == definition) {  /* \.{@@d} */
        @<Scan a definition@>@;
        continue;
    }
    if (next_control == begin_C) {  /* \.{@@c} or \.{@@p} */
      p=name_dir; break;
    }
    if (next_control == section_name) { /* \.{@@<} or \.{@@(} */
      p=cur_section_name;
      @<If section is not being defined, |continue| @>;
      break;
    }
    return; /* \.{@@\ } or \.{@@*} */
  }
  no_where=print_where=0;
  @<Scan the \CEE/ part of the current section@>;
}

@ At the top of this loop, if |next_control==section_name|, the
section name has already been scanned (see |@<Get control code
and...@>|).  Thus, if we encounter |next_control==section_name| in the
skip-ahead process, we should likewise scan the section name, so later
processing will be the same in both cases.

@<Skip ahead until |next_control| ...@>=
while (next_control<definition)
      /* |definition| is the lowest of the ``significant'' codes */
  if((next_control=skip_ahead())==section_name){
    loc-=2; next_control=get_next();
  }

@ @<Scan a definition@>= {
  while ((next_control=get_next())=='\n'); /*allow newline before definition */
  if (next_control!=identifier) {
    err_print("! Definition flushed, must start with identifier");
@.Definition flushed...@>
    continue;
  }
  app_repl(((a=id_lookup(id_first,id_loc,0)-name_dir) / 0400)+0200);
        /* append the lhs */
  app_repl(a % 0400);
  if (*loc!='(') { /* identifier must be separated from replacement text */
    app_repl(string); app_repl(' '); app_repl(string);
  }
  scan_repl(macro);
  cur_text->text_link=0; /* |text_link==0| characterizes a macro */
}

@ If the section name is not followed by \.{=} or \.{+=}, no \CEE/
code is forthcoming: the section is being cited, not being
defined.  This use is illegal after the definition part of the
current section has started, except inside a comment, but
\.{CTANGLE} does not enforce this rule; it simply ignores the offending
section name and everything following it, up to the next significant
control code.

@<If section is not being defined, |continue| @>=
while ((next_control=get_next())=='+'); /* allow optional \.{+=} */
if (next_control!='=' && next_control!=eq_eq)
  continue;

@ @<Scan the \CEE/...@>=
@<Insert the section number into |tok_mem|@>;
scan_repl(section_name); /* now |cur_text| points to the replacement text */
@<Update the data structure so that the replacement text is accessible@>;

@ @<Insert the section number...@>=
store_two_bytes((sixteen_bits)(0150000+section_count));
  /* |0150000==0320*0400| */

@ @<Update the data...@>=
if (p==name_dir||p==0) { /* unnamed section, or bad section name */
  (last_unnamed)->text_link=cur_text-text_info; last_unnamed=cur_text;
}
else if (p->equiv==(char *)text_info) p->equiv=(char *)cur_text;
  /* first section of this name */
else {
  q=(text_pointer)p->equiv;
  while (q->text_link<section_flag)
    q=q->text_link+text_info; /* find end of list */
  q->text_link=cur_text-text_info;
}
cur_text->text_link=section_flag;
  /* mark this replacement text as a nonmacro */

@ @<Predec...@>=
void phase_one();

@ @c
void
phase_one() {
  phase=1;
  section_count=0;
  reset_input();
  skip_limbo();
  while (!input_has_ended) scan_section();
  check_complete();
  phase=2;
}

@ Only a small subset of the control codes is legal in limbo, so limbo
processing is straightforward.

@<Predecl...@>=
void skip_limbo();

@ @c
void
skip_limbo()
{
  char c;
  while (1) {
    if (loc>limit && get_line()==0) return;
    *(limit+1)='@@';
    while (*loc!='@@') loc++;
    if (loc++<=limit) {
      c=*loc++;
      if (ccode[(eight_bits)c]==new_section) break;
      switch (ccode[(eight_bits)c]) {
        case translit_code: @<Read in transliteration of a character@>; break;
        case format_code: case '@@': break;
        case control_text: if (c=='q' || c=='Q') {
          while ((c=skip_ahead())=='@@');
          if (*(loc-1)!='>')
            err_print("! Double @@ should be used in control text");
@.Double @@ should be used...@>
          break;
          } /* otherwise fall through */
        default: err_print("! Double @@ should be used in limbo");
@.Double @@ should be used...@>
      }
    }
  }
}

@ @<Read in transliteration of a character@>=
  while(xisspace(*loc)&&loc<limit) loc++;
  loc+=3;
  if (loc>limit || !xisxdigit(*(loc-3)) || !xisxdigit(*(loc-2)) @|
         || (*(loc-3)>='0' && *(loc-3)<='7') || !xisspace(*(loc-1)))
    err_print("! Improper hex number following @@l");
@.Improper hex number...@>
  else {
    unsigned i;
    char *beg;
    sscanf(loc-3,"%x",&i);
    while(xisspace(*loc)&&loc<limit) loc++;
    beg=loc;
    while(loc<limit&&(xisalpha(*loc)||xisdigit(*loc)||*loc=='_')) loc++;
    if (loc-beg>=translit_length)
      err_print("! Replacement string in @@l too long");
@.Replacement string in @@l...@>
    else{
      strncpy(translit[i-0200],beg,loc-beg);
      translit[i-0200][loc-beg]='\0';
    }
  }

@ Because on some systems the difference between two pointers is a |long|
but not an |int|, we use \.{\%ld} to print these quantities.

@c
void
print_stats() {
  printf("\nMemory usage statistics:\n");
  printf("%ld names (out of %ld)\n",
          (long)(name_ptr-name_dir),(long)max_names);
  printf("%ld replacement texts (out of %ld)\n",
          (long)(text_ptr-text_info),(long)max_texts);
  printf("%ld bytes (out of %ld)\n",
          (long)(byte_ptr-byte_mem),(long)max_bytes);
  printf("%ld tokens (out of %ld)\n",
          (long)(tok_ptr-tok_mem),(long)max_toks);
}

@** Index.
Here is a cross-reference table for \.{CTANGLE}.
All sections 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 section names are not indexed. Underlined entries
correspond to where the identifier was declared. Error messages and
a few other things like ``ASCII code dependencies'' are indexed here too.