/*@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 */