/*@z10.c:Cross References:CrossInit(), CrossMake()@***************************/
/* */
/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.41) */
/* COPYRIGHT (C) 1991, 2023 Jeffrey H. Kingston */
/* */
/* Jeffrey H. Kingston (jeff@it.usyd.edu.au) */
/* School of Information Technologies */
/* 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 3, 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"
#include "child.h"
#include "parent.h"
#define NO_TARGET 0
#define SEEN_TARGET 1
#define WRITTEN_TARGET 2
#define INIT_CROSSREF_NUM 100
static OBJECT RootCross; /* 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) 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 = ( ((unsigned 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; unsigned 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; unsigned 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)
{ int i; CROSSREF_ENTRY x;
if( S == NULL )
{
debug0(DCR, D, " null table");
return;
}
debug2(DCR, D, " table size: %d; current count: %d",
crtab_size(S), crtab_count(S));
for( i = 0; i < crtab_size(S); i++ )
{
debug1(DCR, D, "crtab_chain(S, %d) =", i);
for( x = crtab_chain(S, i); x != NULL; x = x->crtab_next )
{
debug3(DCR, D, " %s:%s,%d",
SymName(x->crtab_sym), FileName(x->crtab_fnum), x->crtab_value);
}
}
} /* end crtab_debug */
#endif
static CROSSREF_TABLE crossref_tab;
/*****************************************************************************/
/* */
/* void CrossInitModule(void) */
/* */
/* Initialize this module. */
/* */
/*****************************************************************************/
void CrossInitModule(void)
{
RootCross = nilobj;
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], *file_name;
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));
file_name = 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));
if( StringLength(file_name) + 20 >= MAX_BUFF )
Error(10, 3, "automatically generated tag is too long (contains %s)",
FATAL, &fpos(x), file_name);
sprintf( (char *) buff, "%d.%d.%s.%d",
file_num(fpos(sym)), line_num(fpos(sym)), file_name, 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. */
/* */
/*****************************************************************************/
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;
OBJECT nbt[2], nft[2], ntarget, nenclose;
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");
ntarget = nenclose = nilobj;
nbt[COLM] = nft[COLM] = nbt[ROWM] = nft[ROWM] = nilobj;
tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE, &nenclose, FALSE);
debug0(DOM, D, " ] returning from Manifest");
tag = ReplaceWithTidy(tag, WORD_TIDY); /* && */
/* 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, DD, "Retrieving %s, env = %s", SymName(sym),
EchoObject(env));
}
else
{ debug1(DCR, DD, "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, D, "[ CrossSequence %s %s", Image(ctype), EchoObject(x));
debug1(DCR, DD, " x = %s", EchoObject(x));
ifdebug(DCR, D, 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, WORD_TIDY);
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 || ctype == GALL_FOLL_OR_PREC ) */
if( ctype == GALL_PREC )
{ if( gall_tag(cs) == nilobj )
{
if( ctype == GALL_PREC )
Error(10, 12, "no %s galley target precedes this %s%s%s", WARN,
&fpos(val), SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
else
Error(10, 22, "no %s galley target follows or precedes this %s%s%s",
WARN, &fpos(val), SymName(sym), SymName(sym), KW_CROSS,
KW_FOLL_OR_PREC);
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!" );
debug4(DCR, DD, " inserting galley (%s) %s&%s %s",
ctype == GALL_PREC ? "GALL_PREC" : "GALL_FOLL_OR_PREC", 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, D, " 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, D, " 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, D, " 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, D, " 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, WORD_TIDY); /* && */
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, D, "] CrossSequence returning.");
debug0(DCR, D, " 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, D, "[ 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:
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);
gall_tag(cs) = MakeWord(WORD, STR_NONE, no_fpos);
}
debug3(DCR, DD, " inserting galley (foll_or_prec) %s&%s %s",
SymName(sym), string(gall_tag(cs)), string(y));
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, D, "] CrossClose returning.");
ifdebug(DCR, DD, crtab_debug(crossref_tab));
} /* end CrossClose */
