1 /*@z10.c:Cross References:CrossInit(), CrossMake()@***************************/
2 /* */
3 /* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.39) */
4 /* COPYRIGHT (C) 1991, 2008 Jeffrey H. Kingston */
5 /* */
6 /* Jeffrey H. Kingston (jeff@it.usyd.edu.au) */
7 /* School of Information Technologies */
8 /* The University of Sydney 2006 */
9 /* AUSTRALIA */
10 /* */
11 /* This program is free software; you can redistribute it and/or modify */
12 /* it under the terms of the GNU General Public License as published by */
13 /* the Free Software Foundation; either Version 3, or (at your option) */
14 /* any later version. */
15 /* */
16 /* This program is distributed in the hope that it will be useful, */
17 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
18 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
19 /* GNU General Public License for more details. */
20 /* */
21 /* You should have received a copy of the GNU General Public License */
22 /* along with this program; if not, write to the Free Software */
23 /* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */
24 /* */
25 /* FILE: z10.c */
26 /* MODULE: Cross References */
27 /* EXTERNS: CrossInit(), CrossMake(), GallTargEval(), CrossAddTag(), */
28 /* CrossExpand(), CrossSequence(), CrossClose() */
29 /* */
30 /*****************************************************************************/
31 #include "externs.h"
32 #define NO_TARGET 0
33 #define SEEN_TARGET 1
34 #define WRITTEN_TARGET 2
35 #define INIT_CROSSREF_NUM 100
36
37 static OBJECT RootCross; /* header for all crs */
38
39 /*****************************************************************************/
40 /* */
41 /* CROSSREF_TABLE */
42 /* */
43 /* A symbol table permitting access to cross reference generated tags by */
44 /* a mapping (symbol x file) -> current tag. */
45 /* */
46 /* crtab_getnext(sym, fnum, S) Get next value associated with sym,fnum */
47 /* crtab_debug(S) Debug print of table S to file fp */
48 /* */
49 /*****************************************************************************/
50
51 typedef struct crossref_rec
52 { struct crossref_rec *crtab_next;
53 OBJECT crtab_sym;
54 FILE_NUM crtab_fnum;
55 int crtab_value;
56 } *CROSSREF_ENTRY;
57
58 typedef struct
59 { int tab_size; /* size of table */
60 int tab_count; /* number of entries held */
61 CROSSREF_ENTRY tab_chains[1]; /* the chains of entries */
62 } *CROSSREF_TABLE;
63
64 #define crtab_size(S) (S)->tab_size
65 #define crtab_count(S) (S)->tab_count
66 #define crtab_chain(S,i) (S)->tab_chains[i]
67
68 #define hash(pos, sym, fnum, S) \
69 { pos = ( ((unsigned long) sym) + fnum ) % crtab_size(S); \
70 }
71
crtab_new(int newsize)72 static CROSSREF_TABLE crtab_new(int newsize)
73 { CROSSREF_TABLE S; int i;
74 ifdebug(DMA, D, DebugRegisterUsage(MEM_CROSSREF, 1,
75 2*sizeof(int) + newsize*sizeof(CROSSREF_ENTRY)));
76 S = (CROSSREF_TABLE)
77 malloc(2*sizeof(int) + newsize*sizeof(CROSSREF_ENTRY));
78 if( S == (CROSSREF_TABLE) NULL )
79 Error(10, 1, "run out of memory enlarging crossref table", FATAL, no_fpos);
80 crtab_size(S) = newsize;
81 crtab_count(S) = 0;
82 for( i = 0; i < newsize; i++ )
83 crtab_chain(S, i) = (CROSSREF_ENTRY) nilobj;
84 return S;
85 } /* end crtab_new */
86
crtab_rehash(CROSSREF_TABLE S,int newsize)87 static CROSSREF_TABLE crtab_rehash(CROSSREF_TABLE S, int newsize)
88 { CROSSREF_TABLE NewS; int i; unsigned long newpos; CROSSREF_ENTRY p, q;
89 NewS = crtab_new(newsize);
90 for( i = 0; i < crtab_size(S); i++ )
91 { p = crtab_chain(S, i);
92 while( p != NULL )
93 { q = p->crtab_next;
94 hash(newpos, p->crtab_sym, p->crtab_fnum, NewS);
95 p->crtab_next = crtab_chain(NewS, newpos);
96 crtab_chain(NewS, newpos) = p;
97 crtab_count(NewS)++;
98 p = q;
99 }
100 }
101 ifdebug(DMA, D, DebugRegisterUsage(MEM_CROSSREF, -1,
102 -(2*sizeof(int) + crtab_size(S)*sizeof(CROSSREF_ENTRY))));
103 free(S);
104 return NewS;
105 } /* end crtab_rehash */
106
crtab_getnext(OBJECT sym,FILE_NUM fnum,CROSSREF_TABLE * S)107 static int crtab_getnext(OBJECT sym, FILE_NUM fnum, CROSSREF_TABLE *S)
108 { CROSSREF_ENTRY x; OBJECT t; unsigned long pos;
109
110 /* if S is NULL, create a new table */
111 if( *S == NULL ) *S = crtab_new(INIT_CROSSREF_NUM);
112
113 /* if (sym, fnum) exists, increment its value and return it */
114 hash(pos, sym, fnum, *S);
115 for( x = crtab_chain(*S, pos); x != NULL; x = x->crtab_next )
116 { if( x->crtab_sym == sym && x->crtab_fnum == fnum )
117 return ++x->crtab_value;
118 }
119
120 /* if table is full, rehash */
121 if( crtab_count(*S) == crtab_size(*S) )
122 { *S = crtab_rehash(*S, 2*crtab_size(*S));
123 hash(pos, sym, fnum, *S);
124 }
125
126 /* insert a new entry for (sym, fnum) with value 1 */
127 GetMem(t, sizeof(struct crossref_rec), no_fpos);
128 x = (CROSSREF_ENTRY) t;
129 x->crtab_sym = sym;
130 x->crtab_fnum = fnum;
131 x->crtab_next = crtab_chain(*S, pos);
132 crtab_chain(*S, pos) = x;
133 crtab_count(*S)++;
134 return x->crtab_value = 1;
135
136 } /* end crtab_getnext */
137
138 #if DEBUG_ON
crtab_debug(CROSSREF_TABLE S)139 static void crtab_debug(CROSSREF_TABLE S)
140 { int i; CROSSREF_ENTRY x;
141 if( S == NULL )
142 {
143 debug0(DCR, D, " null table");
144 return;
145 }
146 debug2(DCR, D, " table size: %d; current count: %d",
147 crtab_size(S), crtab_count(S));
148 for( i = 0; i < crtab_size(S); i++ )
149 {
150 debug1(DCR, D, "crtab_chain(S, %d) =", i);
151 for( x = crtab_chain(S, i); x != NULL; x = x->crtab_next )
152 {
153 debug3(DCR, D, " %s:%s,%d",
154 SymName(x->crtab_sym), FileName(x->crtab_fnum), x->crtab_value);
155 }
156 }
157 } /* end crtab_debug */
158 #endif
159
160 static CROSSREF_TABLE crossref_tab;
161
162
163 /*****************************************************************************/
164 /* */
165 /* void CrossInitModule(void) */
166 /* */
167 /* Initialize this module. */
168 /* */
169 /*****************************************************************************/
170
CrossInitModule(void)171 void CrossInitModule(void)
172 {
173 RootCross = nilobj;
174 crossref_tab = NULL;
175 }
176
177
178 /*@@**************************************************************************/
179 /* */
180 /* CrossInit(sym) Initialize cross_sym(sym). */
181 /* */
182 /*****************************************************************************/
183
CrossInit(OBJECT sym)184 void CrossInit(OBJECT sym)
185 { OBJECT cs;
186 New(cs, CROSS_SYM);
187 target_state(cs) = NO_TARGET; target_seq(cs) = 0;
188 /* cr_file(cs) = NO_FILE; unused */
189 gall_seq(cs) = 0; gall_tag(cs) = nilobj;
190 gall_tfile(cs) = NO_FILE;
191 symb(cs) = sym; cross_sym(sym) = cs;
192 if( RootCross == nilobj ) New(RootCross, CR_ROOT); Link(RootCross, cs);
193 }
194
195
196 /*****************************************************************************/
197 /* */
198 /* OBJECT CrossMake(sym, val, ctype) */
199 /* */
200 /* Make a cross-reference with the given sym and tag value (NB no fpos). */
201 /* */
202 /*****************************************************************************/
203
CrossMake(OBJECT sym,OBJECT val,int ctype)204 OBJECT CrossMake(OBJECT sym, OBJECT val, int ctype)
205 { OBJECT v1, res;
206 debug3(DCR, DD, "CrossMake(%s, %s, %s)", SymName(sym),
207 EchoObject(val), Image(ctype));
208 New(res, CROSS); cross_type(res) = ctype; threaded(res) = FALSE;
209 New(v1, CLOSURE); actual(v1) = sym;
210 Link(res, v1); Link(res, val);
211 debug1(DCR, DD, "CrossMake returning %s", EchoObject(res));
212 return res;
213 }
214
215 /*@::GallTargEval(), CrossGenTag()@*******************************************/
216 /* */
217 /* OBJECT GallTargEval(sym, dfpos) */
218 /* */
219 /* Produce a suitable cross-reference for a galley target. */
220 /* */
221 /*****************************************************************************/
222
GallTargEval(OBJECT sym,FILE_POS * dfpos)223 OBJECT GallTargEval(OBJECT sym, FILE_POS *dfpos)
224 { OBJECT cs, res;
225 FULL_CHAR buff[MAX_BUFF], *str;
226 debug2(DCR, DD, "GallTargEval( %s,%s )", SymName(sym), EchoFilePos(dfpos));
227 if( cross_sym(sym) == nilobj ) CrossInit(sym);
228 cs = cross_sym(sym);
229 if( file_num(*dfpos) != gall_tfile(cs) )
230 { gall_tfile(cs) = file_num(*dfpos);
231 gall_seq(cs) = 0;
232 }
233 str = FileName(gall_tfile(cs));
234 ++gall_seq(cs);
235 if( StringLength(str) + 6 >= MAX_BUFF )
236 Error(10, 2, "automatically generated tag %s&%d is too long",
237 FATAL, dfpos, str, gall_seq(cs));
238 StringCopy(buff, str);
239 StringCat(buff, AsciiToFull("&"));
240 StringCat(buff, StringInt(gall_seq(cs)));
241 res = CrossMake(sym, MakeWord(WORD, buff, dfpos), GALL_TARG);
242 debug1(DCR, DD, "GallTargEval returning %s", EchoObject(res));
243 return res;
244 } /* end GallTargEval */
245
246
247 /*****************************************************************************/
248 /* */
249 /* static OBJECT CrossGenTag(x) */
250 /* */
251 /* Generate a tag suitable for labelling closure x, in such a way that */
252 /* the same tag is likely to be generated on subsequent runs. */
253 /* */
254 /*****************************************************************************/
255
CrossGenTag(OBJECT x)256 static OBJECT CrossGenTag(OBJECT x)
257 { FULL_CHAR buff[MAX_BUFF], *file_name;
258 OBJECT sym, res; FILE_NUM fnum;
259 int seq;
260 debug1(DCR, DD, "CrossGenTag( %s )", SymName(actual(x)));
261 sym = actual(x);
262 if( cross_sym(sym) == nilobj ) CrossInit(sym);
263 fnum = file_num(fpos(x));
264 file_name = FileName(fnum);
265 seq = crtab_getnext(sym, fnum, &crossref_tab);
266 debug3(DCR, DDD, "%d = crtab_getnext(%s, %s, S); S =",
267 seq, SymName(sym), FileName(fnum));
268 ifdebug(DCR, DDD, crtab_debug(crossref_tab));
269 if( StringLength(file_name) + 20 >= MAX_BUFF )
270 Error(10, 3, "automatically generated tag is too long (contains %s)",
271 FATAL, &fpos(x), file_name);
272 sprintf( (char *) buff, "%d.%d.%s.%d",
273 file_num(fpos(sym)), line_num(fpos(sym)), file_name, seq);
274 res = MakeWord(QWORD, buff, &fpos(x));
275 debug2(DCR, DD, "CrossGenTag( %s ) returning %s", SymName(actual(x)), string(res));
276 return res;
277 } /* end CrossGenTag */
278
279
280 /*@::CrossAddTag()@***********************************************************/
281 /* */
282 /* CrossAddTag(x) */
283 /* */
284 /* Add an automatically generated @Tag parameter to closure x if required. */
285 /* */
286 /*****************************************************************************/
287
CrossAddTag(OBJECT x)288 void CrossAddTag(OBJECT x)
289 { OBJECT link, par, ppar, y;
290 debug1(DCR, DD, "CrossAddTag( %s )", EchoObject(x));
291
292 /* search the parameter list of x for a @Tag parameter */
293 for( link = Down(x); link != x; link = NextDown(link) )
294 { Child(par, link);
295 if( type(par) == PAR && is_tag(actual(par)) )
296 {
297 /* has tag, but if value is empty object, delete it */
298 Child(y, Down(par));
299 if( is_word(type(y)) && StringEqual(string(y), STR_EMPTY) )
300 { DisposeChild(link);
301 link = x;
302 }
303 break;
304 }
305 }
306 if( link == x )
307 {
308 /* search the definition of x for name of its @Tag parameter */
309 ppar = nilobj;
310 for( link=Down(actual(x)); link != actual(x); link = NextDown(link) )
311 { Child(y, link);
312 if( is_par(type(y)) && is_tag(y) )
313 { ppar = y;
314 break;
315 }
316 }
317 if( ppar != nilobj ) /* should always hold */
318 {
319 /* prepare new PAR containing generated tag */
320 New(par, PAR);
321 actual(par) = ppar;
322 y = CrossGenTag(x);
323 Link(par, y);
324
325 /* find the right spot, then link it to x */
326 switch( type(ppar) )
327 {
328 case LPAR: link = Down(x);
329 break;
330
331 case NPAR: link = Down(x);
332 if( Down(x) != x )
333 { Child(y, Down(x));
334 if( type(y) == PAR && type(actual(y)) == LPAR )
335 link = NextDown(link);
336 }
337 break;
338
339 case RPAR: for( link = Down(x); link != x; link = NextDown(link) )
340 { Child(y, link);
341 if( type(y) != PAR ) break;
342 }
343 break;
344 }
345 Link(link, par);
346 }
347 }
348 debug1(DCR, DD, "CrossAddTag returning %s", EchoObject(x));
349 } /* end CrossAddTag */
350
351
352 /*@::CrossExpand()@***********************************************************/
353 /* */
354 /* OBJECT CrossExpand(x, env, style, crs, res_env) */
355 /* */
356 /* Return the value of cross-reference x, with environment *res_env. If */
357 /* x has a non-literal tag, it must be tracked, so an object is added to */
358 /* *crs for this purpose. The result replaces x, which is disposed. */
359 /* */
360 /*****************************************************************************/
361
CrossExpand(OBJECT x,OBJECT env,STYLE * style,OBJECT * crs,OBJECT * res_env)362 OBJECT CrossExpand(OBJECT x, OBJECT env, STYLE *style,
363 OBJECT *crs, OBJECT *res_env)
364 { OBJECT sym, res, tag, y, cs, link, db, tmp, index;
365 int ctype, count, i; FULL_CHAR buff[MAX_BUFF], seq[MAX_BUFF], *str;
366 FILE_NUM fnum, dfnum; BOOLEAN tagerror = FALSE;
367 long cont, dfpos; int dlnum;
368 OBJECT nbt[2], nft[2], ntarget, nenclose;
369 assert( is_cross(type(x)), "CrossExpand: x!" );
370 debug2(DCR, DD, "[ CrossExpand( %s, env, style, %s, res_env )",
371 EchoObject(x), EchoObject(*crs));
372 assert( NextDown(Down(x)) == LastDown(x), "CrossExpand: #args!" );
373
374 /* manifest and tidy the right parameter */
375 Child(tag, LastDown(x));
376 debug0(DOM, D, " [ calling Manifest from CrossExpand");
377 ntarget = nenclose = nilobj;
378 nbt[COLM] = nft[COLM] = nbt[ROWM] = nft[ROWM] = nilobj;
379 tag = Manifest(tag, env, style, nbt, nft, &ntarget, crs, FALSE, FALSE, &nenclose, FALSE);
380 debug0(DOM, D, " ] returning from Manifest");
381 tag = ReplaceWithTidy(tag, WORD_TIDY); /* && */
382
383 /* extract sym (the symbol name) and tag (the tag value) from x */
384 Child(y, Down(x));
385 assert( type(y) == CLOSURE, "ClosureExpand: type(y) != CLOSURE!" );
386 sym = actual(y);
387 ctype = !is_word(type(tag)) ? 1 :
388 StringEqual(string(tag), STR_EMPTY) ? 2 :
389 StringEqual(string(tag), KW_PRECEDING) ? CROSS_PREC :
390 StringEqual(string(tag), KW_FOLL_OR_PREC) ? CROSS_FOLL_OR_PREC :
391 StringEqual(string(tag), KW_FOLLOWING) ? CROSS_FOLL : CROSS_LIT;
392
393 res = nilobj;
394 switch( ctype )
395 {
396
397 case 1:
398
399 Error(10, 4, "value of right parameter of %s is not a simple word",
400 WARN, &fpos(tag), KW_CROSS);
401 break;
402
403
404 case 2:
405
406 Error(10, 5, "value of right parameter of %s is an empty word",
407 WARN, &fpos(tag), KW_CROSS);
408 break;
409
410
411 case CROSS_LIT:
412
413 debug2(DCR, DD, " CROSS_LIT sym %s, tag %s", SymName(sym), string(tag));
414 if( cross_sym(sym) == nilobj ) CrossInit(sym);
415 cs = cross_sym(sym);
416 if( sym == MomentSym && StringEqual(string(tag), KW_NOW) )
417 { /* this is a request for the current time */
418 res = StartMoment();
419 }
420 else
421 { if( !has_tag(sym) )
422 { Error(10, 6, "symbol %s used in cross reference has no %s parameter",
423 WARN, &fpos(x), SymName(sym), KW_TAG);
424 tagerror = TRUE;
425 }
426 for( link = NextUp(Up(cs)); link != cs; link = NextUp(link) )
427 { Parent(db, link);
428 assert( is_word(type(db)), "CrossExpand: db!" );
429 if( DbRetrieve(db, FALSE, sym, string(tag), seq, &dfnum, &dfpos,
430 &dlnum, &cont) )
431 {
432 SwitchScope(nilobj);
433 count = 0;
434 /* condition db != OldCrossDb added to fix inconsistency with */
435 /* the call to AttachEnv below, which always carried it; but */
436 /* there may still be a problem when db != OldCrossDb because */
437 /* in that case all symbols currently visible are declared */
438 /* visible in the database entry; perhaps InitialEnvironment */
439 /* would be best */
440 if( db != OldCrossDb )
441 { SetScope(env, &count, FALSE);
442 debug2(DCR, DD, "Retrieving %s, env = %s", SymName(sym),
443 EchoObject(env));
444 }
445 else
446 { debug1(DCR, DD, "Retrieving %s, env = nilobj", SymName(sym));
447 }
448 res = ReadFromFile(dfnum, dfpos, dlnum);
449 for( i = 1; i <= count; i++ ) PopScope();
450 UnSwitchScope(nilobj);
451 if( db != OldCrossDb ) AttachEnv(env, res);
452 break;
453 }
454 }
455 }
456 break;
457
458
459 case CROSS_PREC:
460 case CROSS_FOLL:
461 case CROSS_FOLL_OR_PREC:
462
463 if( has_tag(sym) )
464 { int new_seq;
465 if( cross_sym(sym) == nilobj ) CrossInit(sym);
466 cs = cross_sym(sym);
467 assert( cs != nilobj, "CrossExpand/CROSS_FOLL: cs == nilobj!" );
468 assert( type(cs) == CROSS_SYM, "CrossExpand/CROSS_FOLL: type(cs)!" );
469
470 /* generate literal tag buff, used to track this cross reference */
471 fnum = file_num(fpos(tag));
472 new_seq = crtab_getnext(sym, fnum, &crossref_tab);
473 str = FileName(fnum);
474
475 if( StringLength(str) + 5 >= MAX_BUFF )
476 Error(10, 7, "automatically generated tag %s_%d is too long",
477 FATAL, &fpos(x), str, new_seq); /* was cr_seq(cs) */
478 StringCopy(buff, str);
479 StringCat(buff, AsciiToFull("_"));
480 StringCat(buff, StringInt(new_seq)); /* was cr_seq(cs) */
481 debug1(DCR, DD, " CROSS_PREC or CROSS_FOLL generated tag %s", buff);
482
483 /* generate tracking cross reference and index, and add to *crs */
484 tmp = CrossMake(sym, MakeWord(WORD, buff, &fpos(tag)), ctype);
485 New(index, ctype);
486 actual(index) = tmp;
487 Link(index, tmp);
488 if( *crs == nilobj ) New(*crs, CR_LIST);
489 Link(*crs, index);
490
491 /* read tracking cross ref from previous run from cross-ref database */
492 if( AllowCrossDb &&
493 DbRetrieve(OldCrossDb, FALSE, sym, buff, seq, &dfnum, &dfpos,
494 &dlnum, &cont) )
495 {
496 SwitchScope(nilobj);
497 res = ReadFromFile(dfnum, dfpos, dlnum);
498 UnSwitchScope(nilobj);
499 }
500 }
501 else
502 { Error(10, 8, "symbol %s used in cross reference has no %s parameter",
503 WARN, &fpos(x), SymName(sym), KW_TAG);
504 tagerror = TRUE;
505 }
506 break;
507
508
509 default:
510
511 assert(FALSE, "CrossExpand ctype");
512 break;
513
514
515 } /* end switch */
516 if( res == nilobj )
517 { OBJECT envt;
518 /* *** reporting this now whether or not crs_wanted
519 if( ctype > 1 && !tagerror && crs_wanted )
520 *** */
521 if( ctype > 1 && !tagerror )
522 { debug3(DCR, DD, " reporting unresolved cross reference %s%s%s",
523 SymName(sym), KW_CROSS, string(tag));
524 Error(10, 9, "unresolved cross reference %s%s%s",
525 WARN, &fpos(x), SymName(sym), KW_CROSS, string(tag));
526 }
527
528 /* build dummy result with environment attached */
529 /* nb at present we are not adding dummy import closures to this! */
530 New(res, CLOSURE); actual(res) = sym;
531 y = res;
532 debug1(DCR, DD, "First y = %s", SymName(actual(y)));
533 while( enclosing(actual(y)) != StartSym )
534 { New(tmp, CLOSURE);
535 actual(tmp) = enclosing(actual(y));
536 debug0(DCR, DDD, " calling SetEnv from CrossExpand (a)");
537 envt = SetEnv(tmp, nilobj);
538 AttachEnv(envt, y);
539 y = tmp;
540 debug1(DCR, DD, "Later y = %s", SymName(actual(y)));
541 }
542 New(envt, ENV); Link(y, envt);
543 }
544
545 /* set environment, replace x by res, debug and exit */
546 *res_env = DetachEnv(res);
547 ReplaceNode(res, x);
548 DisposeObject(x);
549 assert( type(res) == CLOSURE, "CrossExpand: type(res) != CLOSURE!" );
550 assert( actual(res) == sym, "CrossExpand: actual(res) != sym!" );
551 debug1(DCR, DD, "] CrossExpand returning %s", EchoObject(res));
552 debug1(DCR, DD, " *crs = %s", EchoObject(*crs));
553 debug1(DCR, DD, " *res_env = %s", EchoObject(*res_env));
554 return res;
555 } /* end CrossExpand */
556
557
558 /*@::CrossSequence()@*********************************************************/
559 /* */
560 /* CrossSequence(x) */
561 /* */
562 /* Object x is an insinuated cross-reference that has just been popped off */
563 /* the top of the root galley. Resolve it with the sequence of others. */
564 /* */
565 /*****************************************************************************/
566
CrossSequence(OBJECT x)567 void CrossSequence(OBJECT x)
568 { OBJECT sym, tag, val, tmp, cs, par, key, hold_key, link, y, env, hold_env;
569 unsigned ctype; FULL_CHAR buff[MAX_BUFF], *seq;
570 FILE_NUM dfnum; int dfpos, dlnum;
571
572 /* if suppressing cross-referencing, dispose x and quit */
573 if( !AllowCrossDb )
574 { if( Up(x) == x ) DisposeObject(x);
575 debug0(DCR, DD, "CrossSequence returning (!AllowCrossDb).");
576 return;
577 }
578
579 /* get interesting fragments from x */
580 debugcond1(DCR, DD, !is_cross(type(x)), " type(x) = %s, x =", Image(type(x)));
581 ifdebugcond(DCR, DD, !is_cross(type(x)), DebugObject(x));
582 assert( is_cross(type(x)), "CrossSequence: type(x)!" );
583 ctype = cross_type(x);
584 Child(tmp, Down(x));
585 assert( type(tmp) == CLOSURE, "CrossSequence: type(tmp)!" );
586 sym = actual(tmp);
587 if( cross_sym(sym) == nilobj ) CrossInit(sym);
588 cs = cross_sym(sym);
589 assert( type(cs) == CROSS_SYM, "CrossSequence: cs!" );
590
591 /* debug output */
592 debug2(DCR, D, "[ CrossSequence %s %s", Image(ctype), EchoObject(x));
593 debug1(DCR, DD, " x = %s", EchoObject(x));
594 ifdebug(DCR, D, DebugObject(cs));
595
596 /* delete as much of x as possible */
597 Child(tag, NextDown(Down(x)));
598 DeleteLink(NextDown(Down(x)));
599 if( Up(x) == x ) DisposeObject(x);
600
601 switch( ctype )
602 {
603 case GALL_FOLL:
604 case GALL_FOLL_OR_PREC:
605 case GALL_PREC:
606
607 /* find the value of key of the galley, if any */
608 val = tag; key = hold_key = nilobj;
609 assert( type(val) == CLOSURE, "CrossSequence/GALL_FOLL: type(val)!" );
610 if( has_key(actual(val)) )
611 { for( link=Down(actual(val)); link != actual(val); link=NextDown(link) )
612 { Child(y, link);
613 if( is_key(y) )
614 { OBJECT nbt[2], nft[2], crs, ntarget, nenclose;
615 nbt[COLM] = nft[COLM] = nbt[ROWM] = nft[ROWM] = nilobj;
616 crs = ntarget = nenclose = nilobj;
617 New(key, CLOSURE);
618 actual(key) = y;
619 New(hold_key, ACAT);
620 Link(hold_key, key);
621 New(env, ENV);
622 Link(env, val);
623 New(hold_env, ACAT);
624 Link(hold_env, env);
625 debug0(DOM, D, " [ calling Manifest from CrossSequence");
626 key = Manifest(key, env, &save_style(val), nbt, nft,
627 &ntarget, &crs, FALSE, TRUE, &nenclose, FALSE);
628 debug0(DOM, D, " ] returning from Manifest");
629 key = ReplaceWithTidy(key, WORD_TIDY);
630 DeleteLink(Down(env));
631 DisposeObject(hold_env);
632 }
633 }
634 }
635
636 /* write out the galley */
637 dfnum = DatabaseFileNum(&fpos(val));
638 AppendToFile(val, dfnum, &dfpos, &dlnum);
639
640 /* determine the sequence number or string of this galley */
641 if( key == nilobj )
642 { ++gall_seq(cs);
643 StringCopy(buff, StringFiveInt(gall_seq(cs)));
644 seq = buff;
645 }
646 else if( !is_word(type(key)) )
647 { Error(10, 10, "%s parameter is not a word", WARN, &fpos(key), KW_KEY);
648 debug1(DCR, DD, "key = %s", EchoObject(key));
649 seq = STR_BADKEY;
650 }
651 else if( StringEqual(string(key), STR_EMPTY) )
652 { Error(10, 11, "%s parameter is an empty word", WARN,&fpos(key),KW_KEY);
653 seq = STR_BADKEY;
654 }
655 else seq = string(key);
656
657 /* either write out the index immediately or store it for later */
658 /* if( ctype == GALL_PREC || ctype == GALL_FOLL_OR_PREC ) */
659 if( ctype == GALL_PREC )
660 { if( gall_tag(cs) == nilobj )
661 {
662 if( ctype == GALL_PREC )
663 Error(10, 12, "no %s galley target precedes this %s%s%s", WARN,
664 &fpos(val), SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
665 else
666 Error(10, 22, "no %s galley target follows or precedes this %s%s%s",
667 WARN, &fpos(val), SymName(sym), SymName(sym), KW_CROSS,
668 KW_FOLL_OR_PREC);
669 debug0(DCR, DD, " ... so substituting \"none\"");
670 gall_tag(cs) = MakeWord(WORD, STR_NONE, &fpos(val));
671 }
672 assert( is_word(type(gall_tag(cs))) &&
673 !StringEqual(string(gall_tag(cs)), STR_EMPTY),
674 "CrossSequence: gall_tag!" );
675 debug4(DCR, DD, " inserting galley (%s) %s&%s %s",
676 ctype == GALL_PREC ? "GALL_PREC" : "GALL_FOLL_OR_PREC", SymName(sym),
677 string(gall_tag(cs)), seq);
678 DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos, seq,
679 dfnum, (long) dfpos, dlnum, FALSE);
680 }
681 else
682 { tmp = MakeWord(WORD, seq, &fpos(val));
683 cs_type(tmp) = ctype;
684 cs_fnum(tmp) = dfnum;
685 cs_pos(tmp) = dfpos;
686 cs_lnum(tmp) = dlnum;
687 Link(cs, tmp);
688 debug2(DCR, D, " saving galley (foll) %s&? %s", SymName(sym), seq);
689 }
690 DisposeObject(val);
691 if( hold_key != nilobj ) DisposeObject(hold_key);
692 break;
693
694
695 case GALL_TARG:
696
697 if( gall_tag(cs) != nilobj ) DisposeObject(gall_tag(cs));
698 if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
699 {
700 debug2(DCR, D, " GALL_TARG %s put none for %s",
701 SymName(sym), EchoObject(tag));
702 DisposeObject(tag);
703 gall_tag(cs) = MakeWord(WORD, STR_NONE, no_fpos);
704 }
705 else gall_tag(cs) = tag;
706 debug2(DCR, D, " have new %s gall_targ %s", SymName(sym),
707 EchoObject(gall_tag(cs)));
708 for( link = Down(cs); link != cs; link = NextDown(link) )
709 { Child(y, link);
710 assert( is_word(type(y)) && !StringEqual(string(y), STR_EMPTY),
711 "CrossSequence: GALL_TARG y!" );
712 switch( cs_type(y) )
713 {
714
715 case GALL_PREC:
716 case GALL_FOLL:
717 case GALL_FOLL_OR_PREC:
718
719 debug4(DCR, D, " inserting galley (%s) %s&%s %s",
720 Image(cs_type(y)), SymName(sym), string(gall_tag(cs)), string(y));
721 if( Down(y) != y )
722 Child(val, Down(y));
723 else
724 val = nilobj;
725 DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos,
726 string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
727 link = PrevDown(link);
728 DisposeChild(NextDown(link));
729 break;
730
731
732 case CROSS_LIT:
733 case CROSS_PREC:
734 case CROSS_FOLL:
735 case CROSS_FOLL_OR_PREC:
736
737 break;
738
739
740 default:
741
742 assert(FALSE, "CrossSequence: cs_type!");
743 break;
744 }
745 }
746 break;
747
748
749 case CROSS_PREC:
750
751 if( target_state(cs) == NO_TARGET )
752 { Error(10, 13, "no %s precedes this %s%s%s", WARN, &fpos(tag),
753 SymName(sym), SymName(sym), KW_CROSS, KW_PRECEDING);
754 break;
755 }
756 if( target_state(cs) == SEEN_TARGET )
757 {
758 debug2(DCR, DD, " inserting %s cross_targ %s",
759 SymName(sym), target_val(cs));
760 AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
761 &target_lnum(cs));
762 DisposeObject(target_val(cs));
763 target_val(cs) = nilobj;
764 target_state(cs) = WRITTEN_TARGET;
765 }
766 if( !is_word(type(tag)) || StringEqual(string(tag), STR_EMPTY) )
767 {
768 debug2(DCR, DD, " GALL_TARG %s put none for %s", SymName(sym),
769 EchoObject(tag));
770 DisposeObject(tag);
771 tag = MakeWord(WORD, STR_NONE, no_fpos);
772 }
773 debug3(DCR, DD, " inserting cross (prec) %s&%s %s", SymName(sym),
774 string(tag), "0");
775 DbInsert(NewCrossDb, FALSE, sym, string(tag), &fpos(tag), STR_ZERO,
776 target_file(cs), (long) target_pos(cs), target_lnum(cs), TRUE);
777 DisposeObject(tag);
778 break;
779
780
781 case CROSS_FOLL:
782 case CROSS_FOLL_OR_PREC:
783
784 if( !is_word(type(tag)) )
785 { Error(10, 14, "tag of %s is not a simple word",
786 WARN, &fpos(tag), SymName(symb(cs)));
787 debug1(DCR, DD, " tag = %s", EchoObject(tag));
788 }
789 else if( StringEqual(string(tag), STR_EMPTY) )
790 {
791 debug1(DCR, DD, " ignoring cross (foll) %s (empty tag)", SymName(sym));
792 }
793 else
794 { Link(cs, tag);
795 cs_fnum(tag) = file_num(fpos(tag));
796 cs_type(tag) = ctype;
797 debug4(DCR, DD, " storing cross (%s) %s&%s %s", Image(ctype),
798 SymName(sym), string(tag), "?");
799 }
800 break;
801
802
803 case CROSS_TARG:
804
805 /* get rid of old target, if any, and add new one */
806 if( target_state(cs) == SEEN_TARGET )
807 {
808 debug2(DCR, DD, " disposing unused %s cross_targ %s", SymName(sym),
809 target_val(cs));
810 DisposeObject(target_val(cs));
811 }
812 debug2(DCR, DD, " remembering new %s cross_targ %s", SymName(sym),
813 EchoObject(tag));
814 target_val(cs) = tag;
815 assert( Up(tag) == tag, "CrossSeq: Up(tag)!" );
816
817 target_file(cs) = DatabaseFileNum(&fpos(tag));
818 target_state(cs) = SEEN_TARGET;
819
820 /* store tag of the galley, if any, and delete excessive right pars */
821 tag = nilobj;
822 assert( type(target_val(cs)) == CLOSURE, "CrossSequence: target_val!" );
823 link = Down(target_val(cs));
824 for( ; link != target_val(cs); link = NextDown(link) )
825 { Child(par, link);
826 if( type(par) == PAR )
827 {
828 assert( Down(par) != par, "CrossSequence: Down(PAR)!" );
829 if( is_tag(actual(par)) )
830 {
831 /* sort out the value of this tag now */
832 Child(tag, Down(par));
833 tag = ReplaceWithTidy(tag, WORD_TIDY); /* && */
834 if( !is_word(type(tag)) )
835 { Error(10, 15, "tag of %s is not a simple word",
836 WARN, &fpos(tag), SymName(actual(target_val(cs))));
837 debug1(DCR, DD, " tag = %s", EchoObject(tag));
838 }
839 else if( StringEqual(string(tag), STR_EMPTY) )
840 {
841 debug1(DCR, DD, " ignoring cross (own tag) %s (empty tag)",
842 SymName(sym));
843 }
844 else
845 {
846 cs_fnum(tag) = file_num(fpos(tag));
847 cs_type(tag) = CROSS_LIT;
848 Link(cs, tag);
849 debug4(DCR, DD, " storing cross (%s) %s&%s %s",
850 Image(cs_type(tag)), SymName(sym), string(tag), "?");
851 }
852 }
853 else if( type(actual(par)) == RPAR )
854 {
855 /* replace any oversized right parameter by question marks */
856 Child(y, Down(par));
857 switch( type(y) )
858 {
859 case WORD:
860 case QWORD:
861 case ACAT:
862 case OPEN:
863 case NEXT:
864 case NULL_CLOS:
865 case CROSS:
866 case FORCE_CROSS:
867 case TAGGED:
868
869 /* leave objects of these types as is */
870 break;
871
872
873 default:
874
875 /* replace all other types by three question marks */
876 tmp = MakeWord(WORD, AsciiToFull("???"), &fpos(y));
877 ReplaceNode(tmp, y);
878 DisposeObject(y);
879 break;
880
881 }
882 }
883 }
884 }
885
886 /* if new target is already writable, write it */
887 if( Down(cs) != cs )
888 {
889 debug2(DCR, DD, " writing %s cross_targ %s", SymName(sym),
890 EchoObject(target_val(cs)));
891 AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
892 &target_lnum(cs));
893 DisposeObject(target_val(cs));
894 target_val(cs) = nilobj;
895 for( link = Down(cs); link != cs; link = NextDown(link) )
896 { Child(tag, link);
897 assert( is_word(type(tag)) && !StringEqual(string(tag), STR_EMPTY),
898 "CrossSeq: non-WORD or empty tag!" );
899 switch( cs_type(tag) )
900 {
901
902 case CROSS_LIT:
903 case CROSS_FOLL:
904 case CROSS_FOLL_OR_PREC:
905
906 debug3(DCR, DD, " inserting cross (foll) %s&%s %s", SymName(sym),
907 string(tag), "0");
908 DbInsert(NewCrossDb, FALSE, sym, string(tag), &fpos(tag),
909 STR_ZERO, target_file(cs), (long) target_pos(cs),
910 target_lnum(cs), TRUE);
911 link = PrevDown(link);
912 DisposeChild(NextDown(link));
913 break;
914
915
916 case GALL_FOLL:
917 case GALL_PREC:
918 case GALL_FOLL_OR_PREC:
919
920 break;
921
922
923 default:
924
925 assert(FALSE, "CrossSequence: cs_type!");
926 break;
927 }
928 }
929 target_state(cs) = WRITTEN_TARGET;
930 }
931 break;
932
933
934 default:
935
936 assert1(FALSE, "CrossSequence:", Image(ctype));
937 break;
938
939 } /* end switch */
940 debug0(DCR, D, "] CrossSequence returning.");
941 debug0(DCR, D, " cs =");
942 ifdebug(DCR, DD, DebugObject(cs));
943 } /* end CrossSequence */
944
945
946 /*@::CrossClose()@************************************************************/
947 /* */
948 /* CrossClose() */
949 /* */
950 /* Check for dangling forward references, and convert old cross reference */
951 /* database to new one. */
952 /* */
953 /*****************************************************************************/
954
CrossClose(void)955 void CrossClose(void)
956 { OBJECT link, cs, ylink, y, sym; BOOLEAN g; int len, count;
957 FILE_NUM dfnum; long dfpos, cont; int dlnum;
958 FULL_CHAR buff[MAX_BUFF], seq[MAX_BUFF], tag[MAX_BUFF];
959 debug0(DCR, D, "[ CrossClose()");
960 ifdebug(DCR, DD, if( RootCross != nilobj ) DebugObject(RootCross));
961
962 /* if suppressing cross referencing, return */
963 if( !AllowCrossDb )
964 { debug0(DCR, DD, "CrossClose returning (!AllowCrossDb).");
965 return;
966 }
967
968 /* check for dangling forward references and dispose cross ref structures */
969 if( RootCross != nilobj )
970 { for( link = Down(RootCross); link != RootCross; link = NextDown(link) )
971 { Child(cs, link);
972 sym = symb(cs);
973 assert( type(cs) == CROSS_SYM, "CrossClose: type(cs)!" );
974 count = 0;
975 for( ylink = Down(cs); ylink != cs; ylink = NextDown(ylink) )
976 { Child(y, ylink);
977 assert( is_word(type(y)) && !StringEqual(string(y), STR_EMPTY),
978 "CrossClose: GALL_TARG y!" );
979 switch( cs_type(y) )
980 {
981
982 case CROSS_FOLL:
983
984 debug2(DCR, DD, "cs_type(y) = %s, y = %s",
985 Image(cs_type(y)), EchoObject(y));
986 if( count < 5 )
987 Error(10, 16, "no %s follows this %s%s%s", WARN, &fpos(y),
988 SymName(sym), SymName(sym), KW_CROSS, KW_FOLLOWING);
989 else if( count == 5 )
990 Error(10, 17, "and more undefined %s%s%s", WARN, no_fpos,
991 SymName(sym), KW_CROSS, KW_FOLLOWING);
992 count++;
993 break;
994
995
996 case CROSS_FOLL_OR_PREC:
997
998 /* no following target, so switch to preceding */
999 if( target_state(cs) == NO_TARGET )
1000 { Error(10, 18, "no %s follows or precedes this %s%s%s", WARN,
1001 &fpos(y), SymName(sym), SymName(sym),KW_CROSS,KW_FOLL_OR_PREC);
1002 break;
1003 }
1004 if( target_state(cs) == SEEN_TARGET )
1005 {
1006 debug2(DCR, DD, " inserting %s cross_targ %s",
1007 SymName(sym), target_val(cs));
1008 AppendToFile(target_val(cs), target_file(cs), &target_pos(cs),
1009 &target_lnum(cs));
1010 DisposeObject(target_val(cs));
1011 target_val(cs) = nilobj;
1012 target_state(cs) = WRITTEN_TARGET;
1013 }
1014 if( !is_word(type(y)) || StringEqual(string(y), STR_EMPTY) )
1015 {
1016 debug2(DCR, DD, " CROSS_FOLL_OR_PREC %s put none for %s",
1017 SymName(sym), EchoObject(y));
1018 y = MakeWord(WORD, STR_NONE, no_fpos);
1019 }
1020 debug4(DCR, DD, " inserting cross (%s) %s&%s %s",
1021 Image(cs_type(y)), SymName(sym), string(y), "0");
1022 DbInsert(NewCrossDb, FALSE, sym, string(y), &fpos(y), STR_ZERO,
1023 target_file(cs), (long) target_pos(cs), target_lnum(cs), TRUE);
1024 break;
1025
1026
1027 case GALL_FOLL:
1028
1029 debug2(DCR, DD, "cs_type(y) = %s, y = %s",
1030 Image(cs_type(y)), EchoObject(y));
1031 if( count < 5 )
1032 Error(10, 19, "no %s follows this %s%s%s", WARN, &fpos(y),
1033 SymName(sym), SymName(sym), KW_CROSS, KW_FOLLOWING);
1034 else if( count == 5 )
1035 Error(10, 20, "and more undefined %s%s%s", WARN, no_fpos,
1036 SymName(sym), KW_CROSS, KW_FOLLOWING);
1037 DbInsert(NewCrossDb, TRUE, sym, STR_NONE, no_fpos,
1038 string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
1039 count++;
1040 break;
1041
1042
1043 case GALL_FOLL_OR_PREC:
1044
1045 if( gall_tag(cs) == nilobj )
1046 { Error(10, 21, "no %s precedes or follows this %s%s%s", WARN,
1047 &fpos(y), SymName(sym), SymName(sym),KW_CROSS,KW_FOLL_OR_PREC);
1048 gall_tag(cs) = MakeWord(WORD, STR_NONE, no_fpos);
1049 }
1050 debug3(DCR, DD, " inserting galley (foll_or_prec) %s&%s %s",
1051 SymName(sym), string(gall_tag(cs)), string(y));
1052 DbInsert(NewCrossDb, TRUE, sym, string(gall_tag(cs)), no_fpos,
1053 string(y), cs_fnum(y), (long) cs_pos(y), cs_lnum(y), FALSE);
1054 break;
1055
1056
1057 default:
1058
1059 debug1(DCR, DD, "CrossClose: unknown cs_type %s",
1060 Image(cs_type(y)));
1061 assert(FALSE, "CrossClose: unknown cs_type!");
1062 break;
1063 }
1064 }
1065 ifdebug(ANY, D,
1066 if( target_state(cs) == SEEN_TARGET ) DisposeObject(target_val(cs));
1067 if( gall_tag(cs) != nilobj ) DisposeObject(gall_tag(cs));
1068 );
1069 }
1070 ifdebug(ANY, D, DisposeObject(RootCross); );
1071 }
1072
1073 /* add to NewCrossDb those entries of OldCrossDb from other source files */
1074 /* but set check to FALSE so that we don't worry about duplication there */
1075 cont = 0L; len = StringLength(DATA_SUFFIX);
1076 while( DbRetrieveNext(OldCrossDb,&g,&sym,tag,seq,&dfnum,&dfpos,&dlnum,&cont))
1077 { if( g ) continue;
1078 StringCopy(buff, FileName(dfnum));
1079 StringCopy(&buff[StringLength(buff) - len], STR_EMPTY);
1080 if( FileNum(buff, STR_EMPTY) == NO_FILE )
1081 DbInsert(NewCrossDb, FALSE, sym, tag, no_fpos, seq, dfnum, dfpos,
1082 dlnum, FALSE);
1083 }
1084
1085 /* close OldCrossDb's .li file so that NewCrossDb can use its name */
1086 DbClose(OldCrossDb);
1087
1088 /* make NewCrossDb readable, for next run */
1089 DbConvert(NewCrossDb, TRUE);
1090
1091 debug0(DCR, D, "] CrossClose returning.");
1092 ifdebug(DCR, DD, crtab_debug(crossref_tab));
1093 } /* end CrossClose */
1094