Lout 3.17.

git-svn-id: http://svn.savannah.nongnu.org/svn/lout/trunk@2 9365b830-b601-4143-9ba8-b4a8e2c3339c

1 files changed, 1078 insertions, 0 deletions

diff --git a/z10.c b/z10.c
new file mode 100644
index 0000000..a6d052b
--- /dev/null
+++ b/z10.c
@@ -0,0 +1,1078 @@
+/*@z10.c:Cross References:CrossInit(), CrossMake()@***************************/
+/*                                                                           */
+/*  THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.17)                       */
+/*  COPYRIGHT (C) 1991, 1999 Jeffrey H. Kingston                             */
+/*                                                                           */
+/*  Jeffrey H. Kingston (jeff@cs.usyd.edu.au)                                */
+/*  Basser Department of Computer Science                                    */
+/*  The University of Sydney 2006                                            */
+/*  AUSTRALIA                                                                */
+/*                                                                           */
+/*  This program is free software; you can redistribute it and/or modify     */
+/*  it under the terms of the GNU General Public License as published by     */
+/*  the Free Software Foundation; either Version 2, or (at your option)      */
+/*  any later version.                                                       */
+/*                                                                           */
+/*  This program is distributed in the hope that it will be useful,          */
+/*  but WITHOUT ANY WARRANTY; without even the implied warranty of           */
+/*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            */
+/*  GNU General Public License for more details.                             */
+/*                                                                           */
+/*  You should have received a copy of the GNU General Public License        */
+/*  along with this program; if not, write to the Free Software              */
+/*  Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA   */
+/*                                                                           */
+/*  FILE:         z10.c                                                      */
+/*  MODULE:       Cross References                                           */
+/*  EXTERNS:      CrossInit(), CrossMake(), GallTargEval(), CrossAddTag(),   */
+/*                CrossExpand(), CrossSequence(), CrossClose()               */
+/*                                                                           */
+/*****************************************************************************/
+#include "externs.h"
+#define	NO_TARGET	0
+#define	SEEN_TARGET	1
+#define	WRITTEN_TARGET	2
+#define INIT_CROSSREF_NUM	100
+
+static OBJECT RootCross = nilobj;		/* header for all crs        */
+
+/*****************************************************************************/
+/*                                                                           */
+/*  CROSSREF_TABLE                                                           */
+/*                                                                           */
+/*  A symbol table permitting access to cross reference generated tags by    */
+/*  a mapping (symbol x file) -> current tag.                                */
+/*                                                                           */
+/*     crtab_getnext(sym, fnum, S)   Get next value associated with sym,fnum */
+/*     crtab_debug(S, fp)            Debug print of table S to file fp       */
+/*                                                                           */
+/*****************************************************************************/
+
+typedef struct crossref_rec
+{ struct crossref_rec	*crtab_next;
+  OBJECT		crtab_sym;
+  FILE_NUM		crtab_fnum;
+  int			crtab_value;
+} *CROSSREF_ENTRY;
+
+typedef struct
+{ int tab_size;					/* size of table             */
+  int tab_count;				/* number of entries held    */
+  CROSSREF_ENTRY tab_chains[1];			/* the chains of entries     */
+} *CROSSREF_TABLE;
+
+#define	crtab_size(S)	(S)->tab_size
+#define	crtab_count(S)	(S)->tab_count
+#define	crtab_chain(S,i) (S)->tab_chains[i]
+
+#define hash(pos, sym, fnum, S)						\
+{ pos = ( ((long) sym) + fnum ) % crtab_size(S);				\
+}
+
+static CROSSREF_TABLE crtab_new(int newsize)
+{ CROSSREF_TABLE S;  int i;
+  ifdebug(DMA, D, DebugRegisterUsage(MEM_CROSSREF, 1,
+    2*sizeof(int) + newsize*sizeof(CROSSREF_ENTRY)));
+  S = (CROSSREF_TABLE)
+    malloc(2*sizeof(int) + newsize*sizeof(CROSSREF_ENTRY));
+  if( S == (CROSSREF_TABLE) NULL )
+    Error(10, 1, "run out of memory enlarging crossref table", FATAL, no_fpos);
+  crtab_size(S) = newsize;
+  crtab_count(S) = 0;
+  for( i = 0;  i < newsize;  i++ )
+    crtab_chain(S, i) = (CROSSREF_ENTRY) nilobj;
+  return S;
+} /* end crtab_new */
+
+static CROSSREF_TABLE crtab_rehash(CROSSREF_TABLE S, int newsize)
+{ CROSSREF_TABLE NewS;  int i;  long newpos;  CROSSREF_ENTRY p, q;
+  NewS = crtab_new(newsize);
+  for( i = 0;  i < crtab_size(S);  i++ )
+  { p = crtab_chain(S, i);
+    while( p != NULL )
+    { q = p->crtab_next;
+      hash(newpos, p->crtab_sym, p->crtab_fnum, NewS);
+      p->crtab_next = crtab_chain(NewS, newpos);
+      crtab_chain(NewS, newpos) = p;
+      crtab_count(NewS)++;
+      p = q;
+    }
+  }
+  ifdebug(DMA, D, DebugRegisterUsage(MEM_CROSSREF, -1,
+   -(2*sizeof(int) + crtab_size(S)*sizeof(CROSSREF_ENTRY))));
+  free(S);
+  return NewS;
+} /* end crtab_rehash */
+
+static int crtab_getnext(OBJECT sym, FILE_NUM fnum, CROSSREF_TABLE *S)
+{ CROSSREF_ENTRY x;  OBJECT t;  long pos;
+
+  /* if S is NULL, create a new table */
+  if( *S == NULL )  *S = crtab_new(INIT_CROSSREF_NUM);
+
+  /* if (sym, fnum) exists, increment its value and return it */
+  hash(pos, sym, fnum, *S);
+  for( x = crtab_chain(*S, pos);  x != NULL;  x = x->crtab_next )
+  { if( x->crtab_sym == sym && x->crtab_fnum == fnum )
+    return ++x->crtab_value;
+  }
+
+  /* if table is full, rehash */
+  if( crtab_count(*S) == crtab_size(*S) )
+  { *S = crtab_rehash(*S, 2*crtab_size(*S));
+    hash(pos, sym, fnum, *S);
+  }
+
+  /* insert a new entry for (sym, fnum) with value 1 */
+  GetMem(t, sizeof(struct crossref_rec), no_fpos);
+  x = (CROSSREF_ENTRY) t;
+  x->crtab_sym = sym;
+  x->crtab_fnum = fnum;
+  x->crtab_next = crtab_chain(*S, pos);
+  crtab_chain(*S, pos) = x;
+  crtab_count(*S)++;
+  return x->crtab_value = 1;
+
+} /* end crtab_getnext */
+
+#if DEBUG_ON
+static void crtab_debug(CROSSREF_TABLE S, FILE *fp)
+{ int i;  CROSSREF_ENTRY x;
+  if( S == NULL )
+  { fprintf(fp, "  null table\n");
+    return;
+  }
+  fprintf(fp, "  table size: %d;  current count: %d\n",
+    crtab_size(S), crtab_count(S));
+  for( i = 0;  i < crtab_size(S);  i++ )
+  { fprintf(fp, "crtab_chain(S, %d) =", i);
+    for( x = crtab_chain(S, i);  x != NULL;  x = x->crtab_next )
+    { fprintf(fp, " %s:%s,%d",
+	SymName(x->crtab_sym), FileName(x->crtab_fnum), x->crtab_value);
+    }
+    fprintf(fp, "\n");
+  }
+} /* end crtab_debug */
+#endif
+
+static CROSSREF_TABLE crossref_tab = NULL;
+
+
+/*@@**************************************************************************/
+/*                                                                           */
+/*  CrossInit(sym)     Initialize cross_sym(sym).                            */
+/*                                                                           */
+/*****************************************************************************/
+
+void CrossInit(OBJECT sym)
+{ OBJECT cs;
+  New(cs, CROSS_SYM);
+  target_state(cs) = NO_TARGET;  target_seq(cs) = 0;
+  /* cr_file(cs) = NO_FILE; unused */
+  gall_seq(cs) = 0;  gall_tag(cs) = nilobj;
+  gall_tfile(cs) = NO_FILE;
+  symb(cs) = sym;  cross_sym(sym) = cs;
+  if( RootCross == nilobj )  New(RootCross, CR_ROOT);  Link(RootCross, cs);
+}
+
+
+/*****************************************************************************/
+/*                                                                           */
+/*  OBJECT CrossMake(sym, val, ctype)                                        */
+/*                                                                           */
+/*  Make a cross-reference with the given sym and tag value (NB no fpos).    */
+/*                                                                           */
+/*****************************************************************************/
+
+OBJECT CrossMake(OBJECT sym, OBJECT val, int ctype)
+{ OBJECT v1, res;
+  debug3(DCR, DD, "CrossMake(%s, %s, %s)", SymName(sym),
+    EchoObject(val), Image(ctype));
+  New(res, CROSS);  cross_type(res) = ctype;  threaded(res) = FALSE;
+  New(v1, CLOSURE);  actual(v1) = sym;
+  Link(res, v1);  Link(res, val);
+  debug1(DCR, DD, "CrossMake returning %s", EchoObject(res));
+  return res;
+}
+
+/*@::GallTargEval(), CrossGenTag()@*******************************************/
+/*                                                                           */
+/*  OBJECT GallTargEval(sym, dfpos)                                          */
+/*                                                                           */
+/*  Produce a suitable cross-reference for a galley target.                  */
+/*                                                                           */
+/*****************************************************************************/
+
+OBJECT GallTargEval(OBJECT sym, FILE_POS *dfpos)
+{ OBJECT cs, res;
+  FULL_CHAR buff[MAX_BUFF], *str;
+  debug2(DCR, DD, "GallTargEval( %s,%s )", SymName(sym), EchoFilePos(dfpos));
+  if( cross_sym(sym) == nilobj )  CrossInit(sym);
+  cs = cross_sym(sym);
+  if( file_num(*dfpos) != gall_tfile(cs) )
+  { gall_tfile(cs) = file_num(*dfpos);
+    gall_seq(cs)   = 0;
+  }
+  str = FileName(gall_tfile(cs));
+  ++gall_seq(cs);
+  if( StringLength(str) + 6 >= MAX_BUFF )
+    Error(10, 2, "automatically generated tag %s&%d is too long",
+	FATAL, dfpos, str, gall_seq(cs));
+  StringCopy(buff, str);
+  StringCat(buff, AsciiToFull("&"));
+  StringCat(buff, StringInt(gall_seq(cs)));
+  res = CrossMake(sym, MakeWord(WORD, buff, dfpos), GALL_TARG);
+  debug1(DCR, DD, "GallTargEval returning %s", EchoObject(res));
+  return res;
+} /* end GallTargEval */
+
+
+/*****************************************************************************/
+/*                                                                           */
+/*  static OBJECT CrossGenTag(x)                                             */
+/*                                                                           */
+/*  Generate a tag suitable for labelling closure x, in such a way that      */
+/*  the same tag is likely to be generated on subsequent runs.               */
+/*                                                                           */
+/*****************************************************************************/
+
+static OBJECT CrossGenTag(OBJECT x)
+{ FULL_CHAR buff[MAX_BUFF], *str1, *str2;
+  OBJECT sym, res;  FILE_NUM fnum;
+  int seq;
+  debug1(DCR, DD, "CrossGenTag( %s )", SymName(actual(x)));
+  sym = actual(x);
+  if( cross_sym(sym) == nilobj )  CrossInit(sym);
+  fnum = file_num(fpos(x));
+  str1 = SymName(sym);
+  str2 = FileName(fnum);
+  seq = crtab_getnext(sym, fnum, &crossref_tab);
+  debug3(DCR, DDD, "%d = crtab_getnext(%s, %s, S); S =",
+	seq, SymName(sym), FileName(fnum));
+  ifdebug(DCR, DDD, crtab_debug(crossref_tab, stderr));
+  if( StringLength(str1) + StringLength(str2) + 10 >= MAX_BUFF )
+    Error(10, 3, "automatically generated tag %s.%s.%d is too long",
+	FATAL, no_fpos, str1, str2, seq);
+  /* *** make shorter, little risk
+  StringCopy(buff, str1);
+  StringCat(buff, AsciiToFull("."));
+  *** */
+  StringCopy(buff, StringInt(line_num(fpos(sym))));
+  StringCat(buff, AsciiToFull("."));
+  StringCat(buff, str2);
+  StringCat(buff, AsciiToFull("."));
+  StringCat(buff, StringInt(seq));
+  res = MakeWord(QWORD, buff, &fpos(x));
+  debug2(DCR, DD, "CrossGenTag( %s ) returning %s", SymName(actual(x)), string(res));
+  return res;
+} /* end CrossGenTag */
+
+
+/*@::CrossAddTag()@***********************************************************/
+/*                                                                           */
+/*  CrossAddTag(x)                                                           */
+/*                                                                           */
+/*  Add an automatically generated @Tag parameter to closure x if required.  */
+/*                                                                           */
+/*****************************************************************************/
+
+void CrossAddTag(OBJECT x)
+{ OBJECT link, par, ppar, y;
+  debug1(DCR, DD, "CrossAddTag( %s )", EchoObject(x));
+
+  /* search the parameter list of x for a @Tag parameter */
+  for( link = Down(x);  link != x;  link = NextDown(link) )
+  { Child(par, link);
+    if( type(par) == PAR && is_tag(actual(par)) )
+    {
+      /* has tag, but if value is empty object, delete it */
+      Child(y, Down(par));
+      if( is_word(type(y)) && StringEqual(string(y), STR_EMPTY) )
+      { DisposeChild(link);
+	link = x;
+      }
+      break;
+    }
+  }
+  if( link == x )
+  { 
+      /* search the definition of x for name of its @Tag parameter */
+      ppar = nilobj;
+      for( link=Down(actual(x));  link != actual(x);  link = NextDown(link) )
+      {	Child(y, link);
+	if( is_par(type(y)) && is_tag(y) )
+	{ ppar = y;
+	  break;
+	}
+      }
+      if( ppar != nilobj ) /* should always hold */
+      {
+	/* prepare new PAR containing generated tag */
+	New(par, PAR);
+	actual(par) = ppar;
+	y = CrossGenTag(x);
+	Link(par, y);
+
+	/* find the right spot, then link it to x */
+	switch( type(ppar) )
+	{
+	  case LPAR:	link = Down(x);
+			break;
+
+	  case NPAR:	link = Down(x);
+			if( Down(x) != x )
+			{ Child(y, Down(x));
+			  if( type(y) == PAR && type(actual(y)) == LPAR )
+				link = NextDown(link);
+			}
+			break;
+
+	  case RPAR:	for( link = Down(x); link != x; link = NextDown(link) )
+			{ Child(y, link);
+			  if( type(y) != PAR )  break;
+			}
+			break;
+	}
+	Link(link, par);
+      }
+  }
+  debug1(DCR, DD, "CrossAddTag returning %s", EchoObject(x));
+} /* end CrossAddTag */
+
+
+/*@::CrossExpand()@***********************************************************/
+/*                                                                           */
+/*  OBJECT CrossExpand(x, env, style, crs, res_env)                          */
+/*                                                                           */
+/*  Return the value of cross-reference x, with environment *res_env.  If    */
+/*  x has a non-literal tag, it must be tracked, so an object is added to    */
+/*  *crs for this purpose.  The result replaces x, which is disposed.        */
+/*                                                                           */
+/*****************************************************************************/
+static OBJECT nbt[2] = { nilobj, nilobj };
+static OBJECT nft[2] = { nilobj, nilobj };
+static OBJECT ntarget = nilobj;
+static OBJECT nenclose = nilobj;
+
+OBJECT CrossExpand(OBJECT x, OBJECT env, STYLE *style,
+OBJECT *crs, OBJECT *res_env)
+{ OBJECT sym, res, tag, y, cs, link, db, tmp, index;
+  int ctype, count, i;  FULL_CHAR buff[MAX_BUFF], seq[MAX_BUFF], *str;
+  FILE_NUM fnum, dfnum;  BOOLEAN tagerror = FALSE;
+  long cont, dfpos;  int dlnum;
+  assert( is_cross(type(x)), "CrossExpand: x!" );
+  debug2(DCR, DD, "[ CrossExpand( %s, env, style, %s, res_env )",
+    EchoObject(x), EchoObject(*crs));
+  assert( NextDown(Down(x)) == LastDown(x), "CrossExpand: #args!" );
+
+  /* manifest and tidy the right parameter */
+  Child(tag, LastDown(x));
+  debug0(DOM, D, "  [ calling Manifest from CrossExpand");
+  tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE, &nenclose, FALSE);
+  debug0(DOM, D, "  ] returning from Manifest");
+  tag = ReplaceWithTidy(tag, TRUE);   /* && */
+
+  /* extract sym (the symbol name) and tag (the tag value) from x */
+  Child(y, Down(x));
+  assert( type(y) == CLOSURE, "ClosureExpand: type(y) != CLOSURE!" );
+  sym = actual(y);
+  ctype = !is_word(type(tag)) ? 1 :
+	  StringEqual(string(tag), STR_EMPTY) ? 2 :
+	  StringEqual(string(tag), KW_PRECEDING) ? CROSS_PREC :
+	  StringEqual(string(tag), KW_FOLL_OR_PREC) ? CROSS_FOLL_OR_PREC :
+	  StringEqual(string(tag), KW_FOLLOWING) ? CROSS_FOLL : CROSS_LIT;
+
+  res = nilobj;
+  switch( ctype )
+  {
+
+    case 1:
+
+      Error(10, 4, "value of right parameter of %s is not a simple word",
+	WARN, &fpos(tag), KW_CROSS);
+      break;
+
+
+    case 2:
+    
+      Error(10, 5, "value of right parameter of %s is an empty word",
+	WARN, &fpos(tag), KW_CROSS);
+      break;
+
+
+    case CROSS_LIT:
+    
+      debug2(DCR, DD, "  CROSS_LIT sym %s, tag %s", SymName(sym), string(tag));
+      if( cross_sym(sym) == nilobj )  CrossInit(sym);
+      cs = cross_sym(sym);
+      if( sym == MomentSym && StringEqual(string(tag), KW_NOW) )
+      {	/* this is a request for the current time */
+	res = StartMoment();
+      }
+      else
+      { if( !has_tag(sym) )
+	{ Error(10, 6, "symbol %s used in cross reference has no %s parameter",
+	    WARN, &fpos(x), SymName(sym), KW_TAG);
+	  tagerror = TRUE;
+	}
+	for( link = NextUp(Up(cs));  link != cs;  link = NextUp(link) )
+        { Parent(db, link);
+	  assert( is_word(type(db)), "CrossExpand: db!" );
+	  if( DbRetrieve(db, FALSE, sym, string(tag), seq, &dfnum, &dfpos,
+	      &dlnum, &cont) )
+	  {
+	    SwitchScope(nilobj);
+	    count = 0;
+	    /* condition db != OldCrossDb added to fix inconsistency with */
+	    /* the call to AttachEnv below, which always carried it; but  */
+	    /* there may still be a problem when db != OldCrossDb because */
+	    /* in that case all symbols currently visible are declared    */
+	    /* visible in the database entry; perhaps InitialEnvironment  */
+	    /* would be best */
+	    if( db != OldCrossDb )
+	    { SetScope(env, &count, FALSE);
+	      debug2(DCR, D, "Retrieving %s, env = %s", SymName(sym),
+	        EchoObject(env));
+	    }
+	    else
+	    { debug1(DCR, D, "Retrieving %s, env = nilobj", SymName(sym));
+	    }
+	    res = ReadFromFile(dfnum, dfpos, dlnum);
+	    for( i = 1;  i <= count;  i++ )  PopScope();
+	    UnSwitchScope(nilobj);
+	    if( db != OldCrossDb )  AttachEnv(env, res);
+	    break;
+	  }
+	}
+      }
+      break;
+
+
+    case CROSS_PREC:
+    case CROSS_FOLL:
+    case CROSS_FOLL_OR_PREC:
+    
+      if( has_tag(sym) )
+      { int new_seq;
+	if( cross_sym(sym) == nilobj )  CrossInit(sym);
+        cs = cross_sym(sym);
+        assert( cs != nilobj, "CrossExpand/CROSS_FOLL: cs == nilobj!" );
+        assert( type(cs) == CROSS_SYM, "CrossExpand/CROSS_FOLL: type(cs)!" );
+
+	/* generate literal tag buff, used to track this cross reference */
+        fnum = file_num(fpos(tag));
+	new_seq = crtab_getnext(sym, fnum, &crossref_tab);
+	str = FileName(fnum);
+
+        if( StringLength(str) + 5 >= MAX_BUFF )
+	  Error(10, 7, "automatically generated tag %s_%d is too long",
+	    FATAL, &fpos(x), str, new_seq); /* was cr_seq(cs) */
+        StringCopy(buff, str);
+        StringCat(buff, AsciiToFull("_"));
+        StringCat(buff, StringInt(new_seq)); /* was cr_seq(cs) */
+	debug1(DCR, DD, "  CROSS_PREC or CROSS_FOLL generated tag %s", buff);
+
+	/* generate tracking cross reference and index, and add to *crs */
+        tmp = CrossMake(sym, MakeWord(WORD, buff, &fpos(tag)), ctype);
+        New(index, ctype);
+        actual(index) = tmp;
+        Link(index, tmp);
+        if( *crs == nilobj )  New(*crs, CR_LIST);
+	Link(*crs, index);
+
+	/* read tracking cross ref from previous run from cross-ref database */
+        if( AllowCrossDb &&
+	    DbRetrieve(OldCrossDb, FALSE, sym, buff, seq, &dfnum, &dfpos,
+	      &dlnum, &cont) )
+	{
+	  SwitchScope(nilobj);
+	  res = ReadFromFile(dfnum, dfpos, dlnum);
+	  UnSwitchScope(nilobj);
+	}
+      }
+      else
+      {	Error(10, 8, "symbol %s used in cross reference has no %s parameter",
+	  WARN, &fpos(x), SymName(sym), KW_TAG);
+	tagerror = TRUE;
+      }
+      break;
+
+
+    default:
+    
+      assert(FALSE, "CrossExpand ctype");
+      break;
+
+
+  } /* end switch */
+  if( res == nilobj )
+  { OBJECT envt;
+    /* *** reporting this now whether or not crs_wanted
+    if( ctype > 1 && !tagerror && crs_wanted )
+    *** */
+    if( ctype > 1 && !tagerror )
+    { debug3(DCR, DD, "  reporting unresolved cross reference %s%s%s",
+	SymName(sym), KW_CROSS, string(tag));
+      Error(10, 9, "unresolved cross reference %s%s%s",
+	WARN, &fpos(x), SymName(sym), KW_CROSS, string(tag));
+    }
+
+    /* build dummy result with environment attached */
+    /* nb at present we are not adding dummy import closures to this! */
+    New(res, CLOSURE);  actual(res) = sym;
+    y = res;
+    debug1(DCR, DD, "First y = %s", SymName(actual(y)));
+    while( enclosing(actual(y)) != StartSym )
+    { New(tmp, CLOSURE);
+      actual(tmp) = enclosing(actual(y));
+      debug0(DCR, DDD, "  calling SetEnv from CrossExpand (a)");
+      envt = SetEnv(tmp, nilobj);
+      AttachEnv(envt, y);
+      y = tmp;
+      debug1(DCR, DD, "Later y = %s", SymName(actual(y)));
+    }
+    New(envt, ENV);  Link(y, envt);
+  }
+
+  /* set environment, replace x by res, debug and exit */
+  *res_env = DetachEnv(res);
+  ReplaceNode(res, x);
+  DisposeObject(x);
+  assert( type(res) == CLOSURE, "CrossExpand: type(res) != CLOSURE!" );
+  assert( actual(res) == sym, "CrossExpand: actual(res) != sym!" );
+  debug1(DCR, DD, "] CrossExpand returning %s", EchoObject(res));
+  debug1(DCR, DD, "  *crs = %s", EchoObject(*crs));
+  debug1(DCR, DD, "  *res_env = %s", EchoObject(*res_env));
+  return res;
+} /* end CrossExpand */
+
+
+/*@::CrossSequence()@*********************************************************/
+/*                                                                           */
+/*  CrossSequence(x)                                                         */
+/*                                                                           */
+/*  Object x is an insinuated cross-reference that has just been popped off  */
+/*  the top of the root galley.  Resolve it with the sequence of others.     */
+/*                                                                           */
+/*****************************************************************************/
+
+void CrossSequence(OBJECT x)
+{ OBJECT sym, tag, val, tmp, cs, par, key, hold_key, link, y, env, hold_env;
+  unsigned ctype;  FULL_CHAR buff[MAX_BUFF], *seq;
+  FILE_NUM dfnum;  int dfpos, dlnum;
+
+  /* if suppressing cross-referencing, dispose x and quit */
+  if( !AllowCrossDb )
+  { if( Up(x) == x )  DisposeObject(x);
+    debug0(DCR, DD, "CrossSequence returning (!AllowCrossDb).");
+    return;
+  }
+
+  /* get interesting fragments from x */
+  debugcond1(DCR, DD, !is_cross(type(x)), "  type(x) = %s, x =", Image(type(x)));
+  ifdebugcond(DCR, DD, !is_cross(type(x)), DebugObject(x));
+  assert( is_cross(type(x)), "CrossSequence: type(x)!" );
+  ctype = cross_type(x);
+  Child(tmp, Down(x));
+  assert( type(tmp) == CLOSURE, "CrossSequence: type(tmp)!" );
+  sym = actual(tmp);
+  if( cross_sym(sym) == nilobj )  CrossInit(sym);
+  cs = cross_sym(sym);
+  assert( type(cs) == CROSS_SYM, "CrossSequence: cs!" );
+
+  /* debug output */
+  debug2(DCR, DD, "CrossSequence %s %s", Image(ctype), EchoObject(x));
+  debug1(DCR, DD, "  x = %s", EchoObject(x));
+  ifdebug(DCR, DD, DebugObject(cs));
+
+  /* delete as much of x as possible */
+  Child(tag, NextDown(Down(x)));
+  DeleteLink(NextDown(Down(x)));
+  if( Up(x) == x )  DisposeObject(x);
+
+  switch( ctype )
+  {
+    case GALL_FOLL:
+    case GALL_FOLL_OR_PREC:
+    case GALL_PREC:
+
+      /* find the value of key of the galley, if any */
+      val = tag;  key = hold_key = nilobj;
+      assert( type(val) == CLOSURE, "CrossSequence/GALL_FOLL: type(val)!" );
+      if( has_key(actual(val)) )
+      { for( link=Down(actual(val)); link != actual(val); link=NextDown(link) )
+	{ Child(y, link);
+	  if( is_key(y) )
+	  { OBJECT nbt[2], nft[2], crs, ntarget, nenclose;
+	    nbt[COLM] = nft[COLM] = nbt[ROWM] = nft[ROWM] = nilobj;
+	    crs = ntarget = nenclose = nilobj;
+	    New(key, CLOSURE);
+	    actual(key) = y;
+	    New(hold_key, ACAT);
+	    Link(hold_key, key);
+	    New(env, ENV);
+	    Link(env, val);
+	    New(hold_env, ACAT);
+	    Link(hold_env, env);
+	    debug0(DOM, D, "  [ calling Manifest from CrossSequence");
+	    key = Manifest(key, env, &save_style(val), nbt, nft,
+	      &ntarget, &crs, FALSE, TRUE, &nenclose, FALSE);
+	    debug0(DOM, D, "  ] returning from Manifest");
+	    key = ReplaceWithTidy(key, TRUE);
+	    DeleteLink(Down(env));
+	    DisposeObject(hold_env);
+	  }
+	}
+      }
+
+      /* write out the galley */
+      dfnum = DatabaseFileNum(&fpos(val));
+      AppendToFile(val, dfnum, &dfpos, &dlnum);
+
+      /* determine the sequence number or string of this galley */
+      if( key == nilobj )
+      {	++gall_seq(cs);
+	StringCopy(buff, StringFiveInt(gall_seq(cs)));
+	seq = buff;
+      }
+      else if( !is_word(type(key)) )
+      {	Error(10, 10, "%s parameter is not a word", WARN, &fpos(key), KW_KEY);
+	debug1(DCR, DD, "key = %s", EchoObject(key));
+	seq = STR_BADKEY;
+      }
+      else if( StringEqual(string(key), STR_EMPTY) )
+      {	Error(10, 11, "%s parameter is an empty word", WARN,&fpos(key),KW_KEY);
+	seq = STR_BADKEY;
+      }
+      else seq = string(key);
+
+      /* either write out the index immediately or store it for later */
+      if( ctype == GALL_PREC )
+      {	if( gall_tag(cs) == nilobj )
+	{ Error(10, 12, "no %s precedes this %s%s%s", WARN, &fpos(val),
+	    SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
+	  debug0(DCR, DD, "  ... so substituting \"none\"");
+	  gall_tag(cs) = MakeWord(WORD, STR_NONE, &fpos(val));
+	}
+	assert( is_word(type(gall_tag(cs))) &&
+		!StringEqual(string(gall_tag(cs)), STR_EMPTY),
+			"CrossSequence: gall_tag!" );
+	debug3(DCR, DD, "  inserting galley (prec) %s&%s %s", SymName(sym),
+	  string(gall_tag(cs)), seq);
+	DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos, seq,
+			dfnum, (long) dfpos, dlnum, FALSE);
+      }
+      else
+      {	tmp = MakeWord(WORD, seq, &fpos(val));
+	cs_type(tmp) = ctype;
+	cs_fnum(tmp) = dfnum;
+	cs_pos(tmp) = dfpos;
+	cs_lnum(tmp) = dlnum;
+	Link(cs, tmp);
+	debug2(DCR, DD, "  saving galley (foll) %s&? %s", SymName(sym), seq);
+      }
+      DisposeObject(val);
+      if( hold_key != nilobj )  DisposeObject(hold_key);
+      break;
+
+
+    case GALL_TARG:
+
+      if( gall_tag(cs) != nilobj )  DisposeObject(gall_tag(cs));
+      if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
+      {
+	debug2(DCR, DD, "  GALL_TARG %s put none for %s",
+	  SymName(sym), EchoObject(tag));
+	DisposeObject(tag);
+	gall_tag(cs) = MakeWord(WORD, STR_NONE, no_fpos);
+      }
+      else gall_tag(cs) = tag;
+      debug2(DCR, DD, "  have new %s gall_targ %s", SymName(sym),
+	  EchoObject(gall_tag(cs)));
+      for( link = Down(cs);  link != cs;  link = NextDown(link) )
+      {	Child(y, link);
+	assert( is_word(type(y)) && !StringEqual(string(y), STR_EMPTY),
+				"CrossSequence: GALL_TARG y!" );
+	switch( cs_type(y) )
+	{
+
+	  case GALL_PREC:
+	  case GALL_FOLL:
+	  case GALL_FOLL_OR_PREC:
+
+	    debug4(DCR, DD, "  inserting galley (%s) %s&%s %s",
+	      Image(cs_type(y)), SymName(sym), string(gall_tag(cs)), string(y));
+	    if( Down(y) != y )
+	      Child(val, Down(y));
+            else
+	      val = nilobj;
+	    DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos,
+	      string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
+	    link = PrevDown(link);
+	    DisposeChild(NextDown(link));
+	    break;
+
+
+	  case CROSS_LIT:
+	  case CROSS_PREC:
+	  case CROSS_FOLL:
+	  case CROSS_FOLL_OR_PREC:
+
+	    break;
+
+
+	  default:
+
+	    assert(FALSE, "CrossSequence: cs_type!");
+	    break;
+	}
+      }
+      break;
+
+
+    case CROSS_PREC:
+
+      if( target_state(cs) == NO_TARGET )
+      {	Error(10, 13, "no %s precedes this %s%s%s", WARN, &fpos(tag),
+	  SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
+	break;
+      }
+      if( target_state(cs) == SEEN_TARGET )
+      {
+	debug2(DCR, DD, "  inserting %s cross_targ %s",
+	  SymName(sym), target_val(cs));
+	AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
+	  &target_lnum(cs));
+	DisposeObject(target_val(cs));
+	target_val(cs) = nilobj;
+	target_state(cs) = WRITTEN_TARGET;
+      }
+      if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
+      {
+	debug2(DCR, DD, "  GALL_TARG %s put none for %s", SymName(sym),
+		EchoObject(tag));
+	DisposeObject(tag);
+	tag = MakeWord(WORD, STR_NONE, no_fpos);
+      }
+      debug3(DCR, DD, "  inserting cross (prec) %s&%s %s", SymName(sym),
+	    string(tag), "0");
+      DbInsert(NewCrossDb, FALSE, sym, string(tag), &fpos(tag), STR_ZERO,
+	target_file(cs), (long) target_pos(cs), target_lnum(cs), TRUE);
+      DisposeObject(tag);
+      break;
+
+
+    case CROSS_FOLL:
+    case CROSS_FOLL_OR_PREC:
+
+      if( !is_word(type(tag)) )
+      {	Error(10, 14, "tag of %s is not a simple word",
+	  WARN, &fpos(tag), SymName(symb(cs)));
+	debug1(DCR, DD, "  tag = %s", EchoObject(tag));
+      }
+      else if( StringEqual(string(tag), STR_EMPTY) )
+      {
+        debug1(DCR, DD, "  ignoring cross (foll) %s (empty tag)", SymName(sym));
+      }
+      else
+      { Link(cs, tag);
+	cs_fnum(tag) = file_num(fpos(tag));
+	cs_type(tag) = ctype;
+        debug4(DCR, DD, "  storing cross (%s) %s&%s %s", Image(ctype),
+	  SymName(sym), string(tag), "?");
+      }
+      break;
+
+
+    case CROSS_TARG:
+
+      /* get rid of old target, if any, and add new one */
+      if( target_state(cs) == SEEN_TARGET )
+      {
+	debug2(DCR, DD, "  disposing unused %s cross_targ %s", SymName(sym),
+	  target_val(cs));
+	DisposeObject(target_val(cs));
+      }
+      debug2(DCR, DD, "  remembering new %s cross_targ %s", SymName(sym),
+	EchoObject(tag));
+      target_val(cs) = tag;
+      assert( Up(tag) == tag, "CrossSeq: Up(tag)!" );
+
+      target_file(cs) = DatabaseFileNum(&fpos(tag));
+      target_state(cs) = SEEN_TARGET;
+
+      /* store tag of the galley, if any, and delete excessive right pars */
+      tag = nilobj;
+      assert( type(target_val(cs)) == CLOSURE, "CrossSequence: target_val!" );
+      link = Down(target_val(cs));
+      for( ;  link != target_val(cs);  link = NextDown(link) )
+      {	Child(par, link);
+	if( type(par) == PAR )
+	{
+	  assert( Down(par) != par, "CrossSequence: Down(PAR)!" );
+	  if( is_tag(actual(par)) )
+	  {
+	    /* sort out the value of this tag now */
+	    Child(tag, Down(par));
+	    tag = ReplaceWithTidy(tag, TRUE);  /* && */
+	    if( !is_word(type(tag)) )
+	    { Error(10, 15, "tag of %s is not a simple word",
+	        WARN, &fpos(tag), SymName(actual(target_val(cs))));
+	      debug1(DCR, DD, "  tag = %s", EchoObject(tag));
+	    }
+	    else if( StringEqual(string(tag), STR_EMPTY) )
+	    {
+              debug1(DCR, DD, "  ignoring cross (own tag) %s (empty tag)",
+		  SymName(sym));
+	    }
+	    else
+	    {
+	      cs_fnum(tag) = file_num(fpos(tag));
+	      cs_type(tag) = CROSS_LIT;
+	      Link(cs, tag);
+              debug4(DCR, DD, "  storing cross (%s) %s&%s %s",
+		Image(cs_type(tag)), SymName(sym), string(tag), "?");
+	    }
+	  }
+	  else if( type(actual(par)) == RPAR )
+	  {
+	    /* replace any oversized right parameter by question marks */
+	    Child(y, Down(par));
+	    switch( type(y) )
+	    {
+	      case WORD:
+	      case QWORD:
+	      case ACAT:
+	      case OPEN:
+	      case NEXT:
+	      case NULL_CLOS:
+	      case CROSS:
+	      case FORCE_CROSS:
+	      case TAGGED:
+
+		/* leave objects of these types as is */
+		break;
+
+
+	      default:
+
+		/* replace all other types by three question marks */
+		tmp = MakeWord(WORD, AsciiToFull("???"), &fpos(y));
+		ReplaceNode(tmp, y);
+		DisposeObject(y);
+		break;
+
+	    }
+	  }
+	}
+      }
+
+      /* if new target is already writable, write it */
+      if( Down(cs) != cs )
+      {
+	debug2(DCR, DD, "  writing %s cross_targ %s", SymName(sym),
+		EchoObject(target_val(cs)));
+	AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
+	  &target_lnum(cs));
+	DisposeObject(target_val(cs));
+	target_val(cs) = nilobj;
+	for( link = Down(cs);  link != cs;  link = NextDown(link) )
+	{ Child(tag, link);
+	  assert( is_word(type(tag)) && !StringEqual(string(tag), STR_EMPTY),
+			"CrossSeq: non-WORD or empty tag!" );
+	  switch( cs_type(tag) )
+	  {
+
+	    case CROSS_LIT:
+	    case CROSS_FOLL:
+	    case CROSS_FOLL_OR_PREC:
+
+	      debug3(DCR, DD, "  inserting cross (foll) %s&%s %s", SymName(sym),
+	        string(tag), "0");
+	      DbInsert(NewCrossDb, FALSE, sym, string(tag), &fpos(tag), 
+	        STR_ZERO, target_file(cs), (long) target_pos(cs),
+		target_lnum(cs), TRUE);
+	      link = PrevDown(link);
+	      DisposeChild(NextDown(link));
+	      break;
+
+
+	    case GALL_FOLL:
+	    case GALL_PREC:
+	    case GALL_FOLL_OR_PREC:
+
+	      break;
+
+
+	    default:
+
+	      assert(FALSE, "CrossSequence: cs_type!");
+	      break;
+	  }
+	}
+	target_state(cs) = WRITTEN_TARGET;
+      }
+      break;
+
+
+    default:
+
+      assert1(FALSE, "CrossSequence:", Image(ctype));
+      break;
+
+  } /* end switch */
+  debug0(DCR, DD, "CrossSequence returning.");
+  debug0(DCR, DD, "   cs =");
+  ifdebug(DCR, DD, DebugObject(cs));
+} /* end CrossSequence */
+
+
+/*@::CrossClose()@************************************************************/
+/*                                                                           */
+/*  CrossClose()                                                             */
+/*                                                                           */
+/*  Check for dangling forward references, and convert old cross reference   */
+/*  database to new one.                                                     */
+/*                                                                           */
+/*****************************************************************************/
+
+void CrossClose(void)
+{ OBJECT link, cs, ylink, y, sym;  BOOLEAN g;  int len, count;
+  FILE_NUM dfnum;  long dfpos, cont;  int dlnum;
+  FULL_CHAR buff[MAX_BUFF], seq[MAX_BUFF], tag[MAX_BUFF];
+  debug0(DCR, DD, "CrossClose()");
+  ifdebug(DCR, DD, if( RootCross != nilobj ) DebugObject(RootCross));
+
+  /* if suppressing cross referencing, return */
+  if( !AllowCrossDb )
+  { debug0(DCR, DD, "CrossClose returning (!AllowCrossDb).");
+    return;
+  }
+
+  /* check for dangling forward references and dispose cross ref structures */
+  if( RootCross != nilobj )
+  { for( link = Down(RootCross);  link != RootCross;  link = NextDown(link) )
+    { Child(cs, link);
+      sym = symb(cs);
+      assert( type(cs) == CROSS_SYM, "CrossClose: type(cs)!" );
+      count = 0;
+      for( ylink = Down(cs);  ylink != cs;  ylink = NextDown(ylink) )
+      {	Child(y, ylink);
+	assert( is_word(type(y)) && !StringEqual(string(y), STR_EMPTY),
+				"CrossClose: GALL_TARG y!" );
+	switch( cs_type(y) )
+	{
+
+	  case CROSS_FOLL:
+
+	    debug2(DCR, DD, "cs_type(y) = %s, y = %s",
+	      Image(cs_type(y)), EchoObject(y));
+	    if( count < 5 )
+	      Error(10, 16, "no %s follows this %s%s%s", WARN, &fpos(y),
+	        SymName(sym), SymName(sym), KW_CROSS, KW_FOLLOWING);
+            else if( count == 5 )
+	      Error(10, 17, "and more undefined %s%s%s", WARN, no_fpos,
+	        SymName(sym), KW_CROSS, KW_FOLLOWING);
+	    count++;
+	    break;
+
+
+	  case CROSS_FOLL_OR_PREC:
+
+	    /* no following target, so switch to preceding */
+	    if( target_state(cs) == NO_TARGET )
+	    { Error(10, 18, "no %s follows or precedes this %s%s%s", WARN,
+		&fpos(y), SymName(sym), SymName(sym),KW_CROSS,KW_FOLL_OR_PREC);
+		break;
+	    }
+	    if( target_state(cs) == SEEN_TARGET )
+	    {
+	      debug2(DCR, DD, "  inserting %s cross_targ %s",
+	        SymName(sym), target_val(cs));
+	      AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
+		&target_lnum(cs));
+	      DisposeObject(target_val(cs));
+	      target_val(cs) = nilobj;
+	      target_state(cs) = WRITTEN_TARGET;
+	    }
+	    if( !is_word(type(y)) || StringEqual(string(y), STR_EMPTY) )
+	    {
+	      debug2(DCR, DD, "  CROSS_FOLL_OR_PREC %s put none for %s",
+		SymName(sym), EchoObject(y));
+	      y = MakeWord(WORD, STR_NONE, no_fpos);
+	    }
+	    debug4(DCR, DD, "  inserting cross (%s) %s&%s %s",
+	      Image(cs_type(y)), SymName(sym), string(y), "0");
+	    DbInsert(NewCrossDb, FALSE, sym, string(y), &fpos(y), STR_ZERO,
+	      target_file(cs), (long) target_pos(cs), target_lnum(cs), TRUE);
+	    break;
+
+
+	  case GALL_FOLL:
+
+	    debug2(DCR, DD, "cs_type(y) = %s, y = %s",
+	      Image(cs_type(y)), EchoObject(y));
+	    if( count < 5 )
+	      Error(10, 19, "no %s follows this %s%s%s", WARN, &fpos(y),
+	        SymName(sym), SymName(sym), KW_CROSS, KW_FOLLOWING);
+            else if( count == 5 )
+	      Error(10, 20, "and more undefined %s%s%s", WARN, no_fpos,
+	        SymName(sym), KW_CROSS, KW_FOLLOWING);
+	    DbInsert(NewCrossDb, TRUE, sym, STR_NONE, no_fpos,
+	      string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
+	    count++;
+	    break;
+
+
+	  case GALL_FOLL_OR_PREC:
+
+	    debug3(DCR, DD, "  inserting galley (foll_or_prec) %s&%s %s",
+	      SymName(sym), string(gall_tag(cs)), string(y));
+	    if( gall_tag(cs) == nilobj )
+	      Error(10, 21, "no %s precedes or follows this %s%s%s", WARN,
+		&fpos(y), SymName(sym), SymName(sym),KW_CROSS,KW_FOLL_OR_PREC);
+	    else
+	    {
+	      DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos,
+	        string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
+	    }
+	    break;
+
+
+	  default:
+
+	    debug1(DCR, DD, "CrossClose: unknown cs_type %s",
+	      Image(cs_type(y)));
+	    assert(FALSE, "CrossClose: unknown cs_type!");
+	    break;
+	}
+      }
+      ifdebug(ANY, D,
+	if( target_state(cs) == SEEN_TARGET )  DisposeObject(target_val(cs));
+	if( gall_tag(cs) != nilobj )  DisposeObject(gall_tag(cs));
+      );
+    }
+    ifdebug(ANY, D, DisposeObject(RootCross); );
+  }
+
+  /* add to NewCrossDb those entries of OldCrossDb from other source files */
+  /* but set check to FALSE so that we don't worry about duplication there */
+  cont = 0L;  len = StringLength(DATA_SUFFIX);
+  while( DbRetrieveNext(OldCrossDb,&g,&sym,tag,seq,&dfnum,&dfpos,&dlnum,&cont))
+  { if( g ) continue;
+    StringCopy(buff, FileName(dfnum));
+    StringCopy(&buff[StringLength(buff) - len], STR_EMPTY);
+    if( FileNum(buff, STR_EMPTY) == NO_FILE )
+      DbInsert(NewCrossDb, FALSE, sym, tag, no_fpos, seq, dfnum, dfpos,
+	dlnum, FALSE);
+  }
+
+  /* close OldCrossDb's .li file so that NewCrossDb can use its name */
+  DbClose(OldCrossDb);
+
+  /* make NewCrossDb readable, for next run */
+  DbConvert(NewCrossDb, TRUE);
+
+  debug0(DCR, DD, "CrossClose returning.");
+  ifdebug(DCR, DD, crtab_debug(crossref_tab, stderr));
+} /* end CrossClose */