\documentstyle[noweb]{article}
\pagestyle{noweb}\noweboptions{shortxref}
\begin{document}
Missing ``{\tt @xref tag} {\it label tag},'' where {\it label} is the name of 
a label and {\it tag} is a chunk number, page number, sub-page number, or
other identifying mark.
@
\section{Cross-reference and index support}
<<*>>=
global lines		# all the input lines
global delay		# non-null if markup should be delayed past the first chunk 
global anchordist	# max distance before code chunk to place defining @xref label

procedure main(args)
  lines := []
  <<initialization>>
  delay := &null
  <<swallow [[args]]>>
  while put(lines, line := read()) do
    apply(pass1, line)
  every apply(pass2, !lines)
  <<write trailers if not already written>>
end

procedure apply(pass, line)
    line ? (="@" & pass(tab(upto(' ')|0),  if =" " then tab(0) else &null))
end
<<swallow [[args]]>>=
while case(a := get(args)) of {
  "-delay"     : delay := 1
  "-docanchor" : anchordist := integer(get(args))
  default      : fatal("unknown argument ", image(a))
}
@
<<*>>=
global curfile		# unique id of the current @file
global lastbeginarg	# identifies last chunk (for -delay)
<<initialization>>=
curfile := "standard input?"
lastbeginarg := "never any chunks?"
@
[[anchorlabel]] is the label that references to a code chunk refer to.
The {\LaTeX} back end typically uses the chunk itself, but the HTML
back end will use a spot in the preceding documentation chunk (if
any), as requested by [[-docanchor]] (and non-null [[anchordist]])
and recorded in [[anchorlabel]].
<<*>>=
global allchunks, allidents
global indexlabels, defanchors, uses, anchorlabel, indexanchorlabel
<<initialization>>=
every allchunks | allidents := set()
every indexlabels | defanchors | uses | anchorlabel | indexanchorlabel := table()
@
I set [[textnonblank]] non-null if some text line in the current chunk
contains a non-blank character.
This trick lets me avoid planting anchors in empty documentation chunks.
<<*>>=
procedure pass1(name, arg)
  static lastdefnlabel, thisusecount, lastanchorlabel, nonblank, textnonblank
  initial nonblank := ~' \t'
  case name of {
    "file"  : curfile := uniqueid(arg)
    "begin" : { lastbeginarg := arg; textnonblank := &null }
    "end"   : if match("docs ", arg) & \anchordist & \textnonblank then 
                {<<insert and set [[lastanchorlabel]]>>}
              else 
                lastanchorlabel := &null
    "text"  : /textnonblank := upto(nonblank, arg)
    "defn"  : {
        insert(allchunks, arg)
        slipin("@xref label " || (lastdefnlabel := newdefnlabel(arg)))
        /lastanchorlabel := lastdefnlabel
        /anchorlabel[arg] := lastanchorlabel
        addlabel(defanchors, arg, lastanchorlabel)
        addud(chunkud, "defn", arg, lastanchorlabel)
        thisusecount := 0
      }
    "use"   : 
        if match ("code ", lastbeginarg) then {
          insert(allchunks, arg)
          slipin("@xref label " || lastdefnlabel || "-u" || (thisusecount +:= 1))
          addlabel(uses, arg, lastanchorlabel)
          addud(chunkud, "use", arg, lastanchorlabel)
        } else {
          /textnonblank := upto(nonblank, arg)   # could appear in quoted code
        }
    "index" : {
        <<shift [[name]] and [[arg]]>>
        case name of {
            "use"  : { insert(allidents, arg)
                       addud(indexud, "use", arg, \lastanchorlabel)
                     }
	    "defn" | "localdefn" : { 
                       insert(allidents, arg)
		       (l := \lastanchorlabel) | 
			     slipin("@xref label " || (l := newdocslabel()))
                       addud(indexud, "defn", arg, l)
                       /indexanchorlabel[arg] := l
                       slipin("@xref ref " || l)  # bug fix
                     }
        }
      }
    }
  return
end
@ 
The bug fix\label{multi-def-bug}
alluded to above occurs when there are multiple definitions of an identifier.
In this case, we can't just use [[indexanchorlabel[id]]], because that refers only to 
the first definition.  In the {\TeX} back end, that leads to bogus
tags like \hbox{\it x \small\rm 7b 7b 7b} instead of \hbox{\it x
\small\rm 7b 9 12a}; the first tag is repeated again and again.
Because the tag for the current [[@defn]] is lost by the time pass~2
rolls around, we have to slip it in on pass~1.
@
<<insert and set [[lastanchorlabel]]>>=
t := []; n := anchordist
lastanchorlabel := newdocslabel()
while lines[-1] ?
  if n = 0 | ="@begin docs" then
     { put(lines, "@xref label " || lastanchorlabel); lines |||:= t; break }
  else 
     { if ="@nl" & pos(0) then n -:= 1; push(t, pull(lines)) }
@
[[slipin]] sticks something into [[lines]] just before the current (last) line.
It makes sense only on the first pass.
<<*>>=
procedure slipin(s)
  local last
  last := pull(lines)
  every put(lines, s | last)
  return s
end
<<*>>=
procedure pass2(name, arg)
  static thesedefns, theseuses
  static thischunk # null for docs chunk, arg of @defn for code chunk
  static defout		# number of definitions emitted for each chunk
  initial defout := table(0)
  case name of {
    "begin" : {
       if \delay & lastbeginarg == arg then <<write trailers if not already written>>
       <<copy [[name]] and [[arg]] to output>>
       every thesedefns | theseuses := set()
       thischunk := &null
    }
    "defn" : { thischunk := arg; 
               write("@xref ref " || anchorlabel[arg])
               <<copy [[name]] and [[arg]] to output>> 
               <<write chunk cross-reference>>
             }
# must postpone index cross-reference to end of chunk because
# the info is accumulated in [[thesdefns]] and [[theseuses]] on this pass
    "end" :  { if match("code", arg) then {<<write index cross-reference>>}
               <<copy [[name]] and [[arg]] to output>> 
             }
    "use"  : { write("@xref ref " || (\anchorlabel[arg] | "nw@notdef")) # was "???"
               <<copy [[name]] and [[arg]] to output>> 
             }
    "index" : {
       <<shift [[name]] and [[arg]]>>
       case name of {
         "defn" | "localdefn" : { 
                    insert(thesedefns, arg)
                    # no xref ref because of bug fix
		  }
         "use"  : { insert(theseuses, arg)
                    write("@xref ref ", \indexanchorlabel[arg])
		  }
       }
       name := "index " || name
       <<copy [[name]] and [[arg]] to output>>
    }
    "text" : # grotesque hack! for chunks and index in HTML
       if /thischunk then # docs mode
         case arg of { 
       	   "<nowebchunks>" : lognowebchunks()
           "<nowebindex>"  : lognowebindex()
           default : <<copy [[name]] and [[arg]] to output>>
       	 }
       else <<copy [[name]] and [[arg]] to output>>
    "fatal" : { <<copy [[name]] and [[arg]] to output>>; exit(1) }
    "trailer" : { <<write trailers if not already written>>
                  <<copy [[name]] and [[arg]] to output>>
                }
    default : <<copy [[name]] and [[arg]] to output>>
  }
  return
end
@ 
The case of the [[@index defn]] is the one case where we don't emit a
reference, because the reference has to go in earlier.  See
page~\pageref{multi-def-bug} for an explanation.
@
<<write chunk cross-reference>>=
defout[thischunk] +:= 1
write("@xref prevdef ", defanchors[thischunk][defout[thischunk] - 1]) # fail if first
write("@xref nextdef ", defanchors[thischunk][defout[thischunk] + 1]) # faif if last
if defout[thischunk] = 1 then {<<write use and def summary for chunk cross-reference>>}
<<write index cross-reference>>=
theseuses --:= thesedefns
if *thesedefns > 0 then {
  write("@index begindefs")
  every i := !alphasort(thesedefns) do {
    every u := !\indexud[i] do u ? if ="use " then write("@index isused ", tab(0))
    write("@index defitem ", i)
  }
  write("@index enddefs")
}
if *theseuses > 0 then {
  l := alphasort(theseuses)
  write("@index beginuses")
  every i := !alphasort(theseuses) do {
    every d := !\indexud[i] do d ? if ="defn " then write("@index isdefined ", tab(0))
    write("@index useitem ", i)
  }
  write("@index enduses")
}
#  every write("@literal \\nwindexuse{", TeXliteral(ident := !l), "}",
#                          "{", indexlabels[ident], "}{", thislabel, "}")
<<write use and def summary for chunk cross-reference>>=
if *defanchors[thischunk] > 1 then {
  write("@xref begindefs")
  every write("@xref defitem ", defanchors[thischunk][2 to *defanchors[thischunk]])
  write("@xref enddefs")
}
if \uses[thischunk] then {
  write("@xref beginuses")
  every write("@xref useitem ", !uses[thischunk])
  write("@xref enduses")
} else 
  write("@xref notused ", thischunk)
@
<<shift [[name]] and [[arg]]>>=
{ arg ? { name := tab(upto(' ')|0); arg := if =" " then tab(0) else &null } }
<<copy [[name]] and [[arg]] to output>>=
write("@", name, (" " || \arg) | "")
<<*>>=
procedure lualistimage(l)
  p := "{ "
  s := ""
  every i := 1 to *l do {
    s ||:= p || "[" || i || "] = " || image(l[i])
    p := ", "
  }
  return s || " }"
end
@ 
The following code is a change first effective in version~2.10d.
It ensures that labels are the same whether files are marked up one at
a time or in a group.
This change helps ``book page definition marks'' for the 152 text,
which is processed one chapter at a time for weaving but several
chapters in a group for tangling.
<<*>>=
procedure newdefnlabel(arg)
  static defcounts
  initial defcounts := table(0)
  /defanchors[arg] := []
  k := curfile || "-" || uniqueid(arg)
  defcounts[k] +:= 1
  return "NW" || k || "-" || alphacode(defcounts[k])
end
<<*>>=
procedure newdocslabel()
  static count
  initial count := 0
  return "NWD" || curfile || "-" || alphacode(count +:= 1)
end
<<*>>=
procedure addlabel(tbl, arg, label)
  /tbl[arg] := []
  if tbl[arg][-1] == label then &null
  else put(tbl[arg], label)
  return label
end
<<*>>=      
global chunkud, indexud
procedure addud(udlist, name, arg, label)
  /udlist[arg] := []
  s := name || " " || label
  return udlist[arg][-1] == s | put(udlist[arg], s)
end
<<initialization>>=
every chunkud | indexud := table();
@
Because it's silly to have both a use and a definition point to the same chunk, 
I strip out uses that list the same chunk as their definitions.
<<*>>=
procedure strip_extra_uses(udlista)
  local old, new, item
  old := copy(udlista)
  new := []
  while item := get(old) do
    item ? 
      if ="defn " then 
        <<add item if needed>>
      else if ="use " then 
        if "defn " || tab(0) == !(old|new) then
          &null # write(&errout, "Stripped extra ", item)
        else
          <<add item if needed>>
  return new
end
<<add item if needed>>=
{ new[-1] == item | put(new, item) }
@
[[uniqueid]] eliminates both {\TeX} and HTML specials.
<<*>>=      
procedure uniqueid(name)
  local key
  static idtable, keycounts, badchars, badstars
  initial { idtable := table() ; keycounts := table(0) 
            badchars := ~ (&letters ++ &digits ++ '!$()*+,./:;=?@|')
            badstars := repl("*", *badchars)
          }

  if not member(idtable, name) then {
    # key := make_key(map(name, badchars, badstars)) # deprecated
    key := alphacode(crc(name))
    keycounts[key] +:= 1
    idtable[name] := key 
    if keycounts[key] > 1 then idtable[name] ||:= "." || alphacode(keycounts[key])
  }
  return idtable[name]
end
@ 
The original key routine used the FORTH heuristic on the basename:
first three letters plus the length.  This produced too many collisions.
<<*>>=
procedure make_key(key, len)
    static noslash
    initial noslash := ~ '/'
    key ? return make_key(3(tab(upto('/')), ="/", tab(many(noslash)), pos(0)), *key) |
                 key[1+:3] || alphacode(\len | *key) |
                 key || (alphacode(\len) | "")
end
<<*>>=
global wrote_trailers
<<write trailers if not already written>>=
(if /wrote_trailers then {
   wrote_trailers := 1
   write("@nl")
   write("@nl")
   lognowebchunks()
   lognowebindex() 
} else &null)
@
Now, a special hack, so we can write this stuff in the right place on pass 2.
<<*>>=
procedure lognowebchunks(noheader)
  static called
  if \called then return
  else called := 1

  l := alphasort(allchunks)
  write("@xref beginchunks")
  while name := get(l) do {
    write("@xref chunkbegin ", (\anchorlabel[name] | "nw@notdef"), " ", name)
    every write("@xref chunk", !\chunkud[name])
    write("@xref chunkend")
  }
  write("@xref endchunks")
end
<<*>>=
procedure lognowebindex()
  static called
  if \called then return
  else called := 1

  l := alphasort(allidents)
  write("@index beginindex")
  while name := get(l) do {
    write("@index entrybegin ", (\indexanchorlabel[name] | "nw@notdef"), " ", name)
    every write("@index entry", !strip_extra_uses(\indexud[name]))
    write("@index entryend")
  }
  write("@index endindex")
end
<<*>>=
procedure alphasort(x)
  t := table()
  every s := !x do t[s] := sortkey(s)
  t := sort(t, 2)
  l := []
  every put(l, (!t)[1])
  return l
end
@ 
I tried to ignore special characters when sorting.
This turned out to be too clever by half.
Sample: it would sort [[BALANCER_DEBUGGING]] before 
[[BALANCE_TRANSFORMATION]], because the underscore didn't count.
<<old, evil code>>=
procedure sortkey(s)
  static keep
  initial keep := &lcase ++ ' '
  s := map(s)
  r := ""
  s ? while tab(upto(keep)) do r ||:= move(1)
  return r || "\n" || s         # relies on \n sorting lower than other chars
end
@ My solution is to move to a much simpler scheme in which the only
thing we do is change case.
<<*>>=
procedure sortkey(s)
  return map(s) || "\n" || s         # relies on \n sorting lower than other chars
end
<<*>>=
procedure alphacode(n)
  static codes
  initial codes := &digits || &letters
  return if n < 0 then 
           "-" || alphacode(-n)
         else if n >= *codes then
           alphacode(n / *codes) || alphacode(n % *codes)
         else
           codes[n+1]
end
@ 
<<*>>=
# /* 32-bit Cyclic Redundancy Code  implemented by A. Appel 1986  */
#  
#    this works only if POLY is a prime polynomial in the field
#    of integers modulo 2, of order 32.  Since the representation of this
#    won't fit in a 32-bit word, the high-order bit is implicit.
#    IT MUST ALSO BE THE CASE that the coefficients of orders 31 down to 25
#    are zero.  Fortunately, we have a candidate, from
#         E. J. Watson, "Primitive Polynomials (Mod 2)", Math. Comp 16 (1962).
#    It is:  x^32 + x^7 + x^5 + x^3 + x^2 + x^1 + x^0
# 
#    Now we reverse the bits to get:
#         111101010000000000000000000000001  in binary  (but drop the last 1)
#            f   5   0   0   0   0   0   0  in hex
# */

procedure crc_table() 
  local POLY, sum
  POLY := 16rf5000000
  t := table()
  every i := 0 to 255 do {
    sum := 0
    every j := 7 to 0 by -1 do
      if iand(i, ishift(1, j)) ~= 0 then
        sum := ixor(sum, ishift(POLY, -j))
    t[i] := sum
  }
  return t
end

procedure crc(s)
  local sum
  static table
  initial table := crc_table()
  sum := 0
  s ? while sum := ixor(ishift(sum, -8), table[iand(ixor(sum, ord(move(1))), 255)])
  return sum
end
@ 
<<*>>=
procedure fatal(L[])
  write!(["@fatal noidx "] ||| L)
  write!([&errout, "noweb error in noidx: "] ||| L)
  exit(1)
end
<<*>>=
procedure rcsinfo () 
  return "$Id: noidx.nw,v 1.22 2008/10/06 01:03:05 nr Exp nr $" ||
         "$Name: v2_12 $"
end
@
\section{List of chunks}
\nowebchunks

\twocolumn
\section{Index}
\nowebindex
@
\end{document}