OBJECT SearchSym(FULL_CHAR *str, int len)
{ register int rlen, sum;
register FULL_CHAR *x, *y;
OBJECT p, q, link, plink, entry;
int s;
debug2(DST, DDD, "SearchSym( %c..., %d )", str[0], len);
hash(str, len, sum);
rlen = len;
entry = (OBJECT) &symtab[sum];
for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
{ Child(p, plink);
if( rlen == length(p) )
{ x = str; y = string(p);
do; while( *x++ == *y++ && --rlen );
if( rlen == 0 )
{
debug1(DST, DDD, " found %s", string(p));
s = scope_top;
do
{ s--;
for( link = Down(p); link != p; link = NextDown(link) )
{ Child(q, link);
{ debugcond4(DST, DDD, enclosing(q) == scope[s],
" !npars_only[s] = %s, !vis_only[s] = %s, body_ok[s] = %s, !ss = %s",
bool(!npars_only[s]), bool(!vis_only[s]), bool(body_ok[s]),
bool(!suppress_scope));
}
if( enclosing(q) == scope[s]
&& (!npars_only[s] || type(q) == NPAR)
&& (!vis_only[s] || visible(q) || suppress_visible )
&& (body_ok[s] || type(q)!=RPAR || !has_body(enclosing(q))
|| suppress_visible )
&& (!suppress_scope || StringEqual(string(p), KW_INCLUDE) ||
StringEqual(string(p), KW_SYSINCLUDE))
)
{ debug3(DST, DD, "SearchSym returning %s %s%%%s",
Image(type(q)), SymName(q), SymName(enclosing(q)));
return q;
}
}
} while( scope[s] != StartSym );
}
}
rlen = len;
}
debug0(DST, DDD, "SearchSym returning <nilobj>");
return nilobj;
} /* end SearchSym */
OBJECT SearchGalley(OBJECT start, OBJECT sym, BOOLEAN forwards,
BOOLEAN subgalleys, BOOLEAN closures, BOOLEAN input)
{ OBJECT y, res, z, zlink, link;
debug5(DGA, DD, "[ SearchGalley(start, %s, %s, %s, %s, %s)", SymName(sym),
forwards ? "fwd" : "back", subgalleys ? "subgalleys" : "nosubgalleys",
closures ? "closures" : "noclosures", input ? "input" : "noinput");
assert( type(start) == LINK || type(start) == HEAD, "SearchGalley: start!" );
link = forwards ? NextDown(start) : PrevDown(start);
res = nilobj;
while( res == nilobj && type(link) != HEAD )
{ Child(y, link);
switch( type(y) )
{
case UNATTACHED:
case RECEIVING:
debug1(DGA, DD, " examining %s", EchoIndex(y));
if( subgalleys )
for( zlink = Down(y); zlink!=y && res==nilobj; zlink=NextDown(zlink) )
{ Child(z, zlink);
res = SearchGalley(z, sym, TRUE, TRUE, TRUE, input);
}
if( res == nilobj && input && type(y) == RECEIVING &&
actual(actual(y)) == InputSym )
res = y;
break;
case RECEPTIVE:
debug1(DGA, DD, " examining %s", EchoIndex(y));
if( closures && type(actual(y)) == CLOSURE
&& SearchUses(actual(actual(y)), sym) ) res = y;
else if( input && actual(actual(y)) == InputSym ) res = y;
break;
default:
break;
}
link = forwards ? NextDown(link) : PrevDown(link);
}
debug1(DGA, DD, "] SearchGalley returning %s", EchoIndex(res));
return res;
} /* end SearchGalley */
BOOLEAN EnvWriteRetrieve(OBJECT env, FILE_NUM fnum, int *offset, int *lnum)
{ unsigned int pos; OBJECT link, y, z;
debug2(DET, DD, "EnvWriteRetrieve(env %d, %s)", (int) env, FileName(fnum));
debug1(DET, DDD, " %s", EchoObject(env));
stat_writes++;
hash1(pos, env, fnum);
if( tab[pos] != nilobj )
{
for( link = Down(tab[pos]); link != tab[pos]; link = NextDown(link) )
{ Child(y, link);
Child(z, Down(y));
if( env_fnum(y) == fnum && z == env && !env_read(y) )
{ MoveLink(LastUp(y), env_cache, PARENT);
*offset = env_offset(y);
*lnum = env_lnum(y);
stat_write_hits++;
debug2(DET, DD, "EnvWriteRetrieve returning TRUE (offset %d, lnum %d)",
*offset, *lnum);
return TRUE;
}
}
}
debug0(DET, DD, "EnvWriteRetrieve returning FALSE");
return FALSE;
} /* end EnvWriteRetrieve */
void CheckSymSpread(void)
{ int i, j, sum, usum; OBJECT entry, plink;
fprintf(stderr, "Symbol table spread (table size = %d, symbols = %d):",
MAX_TAB, sym_count);
usum = sum = 0;
for( i = 0; i < MAX_TAB; i++ )
{ fprintf(stderr, "%4d: ", i);
for( j = 1; j <= sym_spread[i]; j++ )
{ fprintf(stderr, ".");
sum += j;
}
entry = (OBJECT) &symtab[i];
for( plink=Down(entry), j=1; plink != entry; plink=NextDown(plink), j++ )
{ fprintf(stderr, "+");
usum += j;
}
fprintf(stderr, "%s", STR_NEWLINE);
}
fprintf(stderr, "average length counting duplicate names = %.1f",
(float) sum / sym_count);
fprintf(stderr, "%s", STR_NEWLINE);
fprintf(stderr, "average length not counting duplicate names = %.1f",
(float) usum / sym_count);
fprintf(stderr, "%s", STR_NEWLINE);
} /* end CheckSymSpread */
OBJECT ChildSym(OBJECT s, unsigned typ)
{ OBJECT link, y;
for( link = Down(s); link != s; link = NextDown(link) )
{ Child(y, link);
if( type(y) == typ && enclosing(y) == s ) return y;
}
Error(29, 10, "symbol %s has missing %s", FATAL, &fpos(s),
SymName(s), Image(typ));
return nilobj;
} /* end ChildSym */
void DeleteEverySym(void)
{ int i, j, load, cost; OBJECT p, plink, link, x, entry;
debug0(DST, DD, "DeleteEverySym()");
/* dispose the bodies of all symbols */
for( i = 0; i < MAX_TAB; i++ )
{ entry = (OBJECT) &symtab[i];
for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
{ Child(p, plink);
for( link = Down(p); link != p; link = NextDown(link) )
{ Child(x, link); DeleteSymBody(x);
/* *** will not work now
while( base_uses(x) != nilobj )
{ tmp = base_uses(x); base_uses(x) = next(tmp);
PutMem(tmp, USES_SIZE);
}
while( uses(x) != nilobj )
{ tmp = uses(x); uses(x) = next(tmp);
PutMem(tmp, USES_SIZE);
}
*** */
}
}
}
/* dispose the symbol name strings, gather statistics, and print them */
load = cost = 0;
for( i = 0; i < MAX_TAB; i++ )
{ j = 1; entry = (OBJECT) &symtab[i];
while( Down(entry) != entry )
{ load += 1; cost += j; j += 1;
DisposeChild(Down(entry));
}
}
if( load > 0 )
{ debug4(DST, DD, "size = %d, items = %d (%d%%), probes = %.1f",
MAX_TAB, load, (100*load)/MAX_TAB, (float) cost/load);
}
else
{ debug1(DST, DD, "table size = %d, no entries in table", MAX_TAB);
}
debug0(DST, DD, "DeleteEverySym returning.");
} /* end DeleteEverySym */
OBJECT ChildSymWithCode(OBJECT s, unsigned char code)
{ OBJECT link, y;
for( link = Down(actual(s)); link != actual(s); link = NextDown(link) )
{ Child(y, link);
if( type(y) == NPAR && enclosing(y) == actual(s) && npar_code(y) == code )
return y;
}
Error(29, 11, "symbol %s has erroneous code %c (database out of date?)",
FATAL, &fpos(s), SymName(actual(s)), (char) code);
return nilobj;
} /* end ChildSym */
void DetachGalley(OBJECT hd)
{ OBJECT prnt, index;
assert( type(hd) == HEAD && Up(hd) != hd, "DetachGalley: precondition!" );
debug1(DGA, D, "DetachGalley( %s )", SymName(actual(hd)));
Parent(prnt, Up(hd));
assert( Up(prnt) != prnt, "DetachGalley: parent!" );
New(index, UNATTACHED);
pinpoint(index) = nilobj;
MoveLink(Up(hd), index, PARENT);
Link(NextDown(Up(prnt)), index);
debug0(DGA, D, "DetachGalley returning.");
} /* end DetachGalley */
void SetNeighbours(OBJECT link, BOOLEAN ratm, OBJECT *pg, OBJECT *pdef,
OBJECT *sg, OBJECT *sdef, int *side)
{ OBJECT plink, slink;
/* find preceding definite; if it exists, set *pg */
*pg = nilobj;
for( plink = PrevDown(link); type(plink) == LINK; plink = PrevDown(plink) )
{ Child(*pdef, plink);
if( type(*pdef) == SPLIT ? SplitIsDefinite(*pdef) : is_definite(type(*pdef)) )
{ Child(*pg, PrevDown(link));
while( is_index(type(*pg)) )
{ link = PrevDown(link);
Child(*pg, PrevDown(link));
}
assert( type(*pg) == GAP_OBJ, "SetNeighbours: type(*pg)!" );
break;
}
}
/* find succeeding definite; if it exists, set *sg */
*sg = nilobj;
for( slink = NextDown(link); type(slink) == LINK; slink = NextDown(slink) )
{ Child(*sdef, slink);
if( type(*sdef) == SPLIT ? SplitIsDefinite(*sdef) : is_definite(type(*sdef)) )
{ Child(*sg, PrevDown(slink));
while( is_index(type(*sg)) )
{ slink = PrevDown(slink);
Child(*sg, PrevDown(slink));
}
assert( type(*sg) == GAP_OBJ, "SetNeighbours: type(*sg)!" );
break;
}
}
*side = ratm ? BACK : *pg == nilobj || mark(gap(*pg)) ? ON : FWD;
debug4(DSA, DD,
"SetNeighbours: ratm == %s, pg %s nilobj, sg %s nilobj, side == %s",
bool(ratm), *pg == nilobj ? "==" : "!=", *sg == nilobj ? "==" : "!=",
*side == BACK ? "BACK" : *side == ON ? "ON" : "FWD");
} /* end SetNeighbours */
void InsertAlternativeName(FULL_CHAR *str, OBJECT s, FILE_POS *xfpos)
{ register int sum, rlen;
register unsigned char *x;
int len;
OBJECT entry, link, plink, p, q;
debug3(DST, DD, "InsertAlternativeName(%s, %s, %s)",
str, SymName(s), EchoFilePos(xfpos));
len = StringLength(str);
hash(str, len, sum);
ifdebug(DST, D, sym_spread[sum]++; sym_count++);
entry = (OBJECT) &symtab[sum];
for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
{ Child(p, plink);
if( length(p) == len && StringEqual(str, string(p)) )
{ for( link = Down(p); link != p; link = NextDown(link) )
{ Child(q, link);
if( enclosing(s) == enclosing(q) )
{ Error(29, 12, "symbol name %s previously defined at%s",
WARN, &fpos(s), str, EchoFilePos(&fpos(q)) );
break;
}
}
goto wrapup;
}
}
/* need a new OBJECT as well as s */
NewWord(p, WORD, len, xfpos);
length(p) = len;
StringCopy(string(p), str);
Link(entry, p);
wrapup:
Link(p, s);
/* not for copies if( enclosing(s) != nilobj ) Link(enclosing(s), s); */
debug0(DST, DD, "InsertAlternativeName returning.");
} /* end InsertAlternativeName */
void FlushInners(OBJECT inners, OBJECT hd)
{ OBJECT y, z, tmp, dest_index;
ifdebug(DGF, D,
OBJECT link;
fprintf(stderr, "dgf: [ FlushInners(");
for( link = Down(inners); link != inners; link = NextDown(link) )
{
Child(y, link);
fprintf(stderr, " %s", Image(type(y)));
switch( type(y) )
{
case DEAD:
break;
case RECEIVING:
case UNATTACHED:
if( Down(y) != y ) /* bug fix (was assert before) */
{ assert( Down(y) != y, "FlushInners: UNATTACHED!");
Child(z, Down(y));
fprintf(stderr, " %s", SymName(actual(z)));
}
break;
case PRECEDES:
break;
case GALL_PREC:
break;
default:
break;
}
}
fprintf(stderr, ")");
debug0(DGF, D, "");
)
/* check for root galley case */
if( hd != nilobj )
void PDF_PrintGraphicObject(OBJECT x)
{ OBJECT y, link;
debug3(DPF, D, "PDF_PrintGraphicObject(%s %s %s)",
EchoFilePos(&fpos(x)), Image(type(x)), EchoObject(x));
switch( type(x) )
{
case WORD:
case QWORD:
PDFPage_WriteGraphic(out_fp, string(x));
break;
case ACAT:
for( link = Down(x); link != x; link = NextDown(link) )
{ Child(y, link);
if( type(y) == GAP_OBJ )
{
if( vspace(y) > 0 ) PDFPage_Write(out_fp, "\n");
else if( hspace(y) > 0 ) PDFPage_Write(out_fp, " ");
}
else if( is_word(type(y)) || type(y) == ACAT )
PDF_PrintGraphicObject(y);
else if( type(y) == WIDE || is_index(type(y)) )
{
/* ignore: @Wide, indexes are sometimes inserted by Manifest */
}
else
{ Error(50, 2, "error in left parameter of %s",
WARN, &fpos(x), KW_GRAPHIC);
debug1(DPF, D, " type(y) = %s, y =", Image(type(y)));
ifdebug(DPF, D, DebugObject(y));
}
}
break;
default:
Error(50, 3, "error in left parameter of %s", WARN, &fpos(x), KW_GRAPHIC);
debug1(DPF, D, " type(x) = %s, x =", Image(type(x)));
ifdebug(DPF, D, DebugObject(x));
break;
}
debug0(DPF, D, "PDF_PrintGraphicObject returning");
} /* end PDF_PrintGraphicObject */
OBJECT ParameterCheck(OBJECT x, OBJECT env)
{ OBJECT link, y, res, prnt_env, par, prnt;
debug2(DCE, DD, "ParameterCheck(%s, %s)", EchoObject(x), EchoObject(env));
assert( type(x) == CLOSURE, "ParameterCheck given non-CLOSURE!");
/* case x is a parameter */
prnt = SearchEnv(env, enclosing(actual(x)));
if( prnt == nilobj )
{ debug0(DCE, DD, "ParameterCheck returning nilobj (prnt fail)");
return nilobj;
}
prnt_env = GetEnv(prnt);
for( link = Down(prnt); link != prnt; link = NextDown(link) )
{ Child(par, link);
if( type(par) == PAR && actual(par) == actual(x) )
{ assert( Down(par) != par, "ParameterCheck: Down(par)!");
Child(y, Down(par));
res = is_word(type(y)) ? CopyObject(y, no_fpos) : nilobj;
debug1(DCE, DD, " ParameterCheck returning %s", EchoObject(res));
return res;
}
}
/* case x is a default parameter */
y = sym_body(actual(x));
if( y == nilobj )
{ res = nilobj;
}
else if( is_word(type(y)) )
{ res = CopyObject(y, &fpos(y));
}
else if( type(y) == CLOSURE && is_par(type(actual(y))) )
{ res = ParameterCheck(y, prnt_env);
}
else
{ res = nilobj;
}
debug1(DCE, DD, "ParameterCheck returning %s", EchoObject(res));
return res;
} /* end ParameterCheck */
BOOLEAN EnvReadRetrieve(FILE_NUM fnum, int offset, OBJECT *env)
{ int pos; OBJECT link, y, z;
debug2(DET, DD, "EnvReadRetrieve(%s, %d)", FileName(fnum), offset);
stat_reads++;
hash2(pos, fnum, offset);
if( tab[pos] != nilobj )
{
for( link = Down(tab[pos]); link != tab[pos]; link = NextDown(link) )
{ Child(y, link);
Child(z, Down(y));
if( env_fnum(y) == fnum && env_offset(y) == offset && env_read(y) )
{ MoveLink(LastUp(y), env_cache, PARENT);
Child(*env, Down(y));
stat_read_hits++;
debug1(DET, DD, "EnvReadRetrieve returning env %d", (int) *env);
return TRUE;
}
}
}
debug0(DET, DD, "EnvReadRetrieve returning FALSE");
return FALSE;
} /* end EnvReadRetrieve */
FULL_CHAR *DebugInnersNames(OBJECT inners)
{ static FULL_CHAR buff[MAX_BUFF];
OBJECT link, y, z;
StringCopy(buff, STR_EMPTY);
if( inners != nilobj )
{ for( link = Down(inners); link != inners; link = NextDown(link) )
{ Child(y, link);
if( link != Down(inners) ) StringCat(buff, STR_SPACE);
switch( type(y) )
{
case RECEIVING:
case UNATTACHED:
assert( Down(y) != y, "DebugInnersNames: UNATTACHED!");
Child(z, Down(y));
StringCat(buff, SymName(actual(z)));
break;
case PRECEDES:
case GALL_PREC:
case DEAD:
StringCat(buff, Image(type(y)));
break;
default:
assert1(FALSE, "DebugInnersNames:", Image(type(y)));
break;
}
}
}
return buff;
} /* end DebugInnersNames */
int AttachGalley(OBJECT hd, OBJECT *inners, OBJECT *suspend_pt)
{ OBJECT hd_index; /* the index of hd in the enclosing galley */
OBJECT hd_inners; /* inner galleys of hd, if unsized */
OBJECT dest; /* the target @Galley hd empties into */
OBJECT dest_index; /* the index of dest */
OBJECT target; /* the target indefinite containing dest */
OBJECT target_index; /* the index of target */
OBJECT target_galley; /* the body of target, made into a galley */
OBJECT tg_inners; /* inner galleys of target_galley */
BOOLEAN need_precedes = FALSE;/* true if destination lies before galley */
OBJECT recs; /* list of recursive definite objects */
OBJECT link, y = nilobj; /* for scanning through the components of hd */
CONSTRAINT c; /* temporary variable holding a constraint */
OBJECT env, n1, tmp, zlink, z, sym; /* placeholders and temporaries */
BOOLEAN was_sized; /* true if sized(hd) initially */
int dim; /* the galley direction */
FULL_LENGTH perp_back, perp_fwd;
OBJECT why, junk;
debug2(DGA, D, "[ AttachGalley(Galley %s into %s)",
SymName(actual(hd)), SymName(whereto(hd)));
ifdebug(DGA, DD, DebugGalley(hd, nilobj, 4));
assert( Up(hd) != hd, "AttachGalley: no index!" );
Parent(hd_index, Up(hd));
assert( type(hd_index) == UNATTACHED, "AttachGalley: not UNATTACHED!" );
hd_inners = tg_inners = nilobj;
was_sized = sized(hd);
dim = gall_dir(hd);
for(;;)
{
/*************************************************************************/
/* */
/* Search for a destination for hd. If hd is unsized, search for */
/* inner galleys preceding it first of all, then for receptive objects */
/* following it, possibly in inner galleys. If no luck, exit. */
/* If hd is sized, search only for receptive objects in the current */
/* galley below the current spot, and fail if cannot find any. */
/* */
/*************************************************************************/
sym = whereto(hd);
if( sized(hd) )
{
/* sized galley case: search on from current spot */
target_index = SearchGalley(Up(hd_index), sym, TRUE, FALSE, TRUE, TRUE);
if( target_index == nilobj )
{
/* search failed to find any new target, so kill the galley */
for( link = Down(hd); link != hd; link = NextDown(link) )
{ Child(y, link);
if( type(y) == SPLIT ) Child(y, DownDim(y, dim));
if( is_definite(type(y)) ) break;
}
if( link != hd )
Error(19, 1, "galley %s deleted from here (no target)",
WARN, &fpos(y), SymName(actual(hd)));
if( hd_inners != nilobj ) DisposeObject(hd_inners), hd_inners=nilobj;
if( tg_inners != nilobj ) DisposeObject(tg_inners), tg_inners=nilobj;
KillGalley(hd, FALSE);
*inners = nilobj;
debug0(DGA, D, "] AttachGalley returning ATTACH_KILLED");
return ATTACH_KILLED;
}
else if( actual(actual(target_index)) == InputSym )
{
/* search found input object, so suspend on that */
DeleteNode(hd_index);
Link(target_index, hd);
*inners = nilobj;
debug0(DGA, D, "] AttachGalley returning ATTACH_INPUT");
return ATTACH_INPUT;
}
}
else /* unsized galley, either backwards or normal */
{
if( foll_or_prec(hd) == GALL_PREC )
{ target_index= SearchGalley(Up(hd_index), sym, FALSE, TRUE,TRUE,FALSE);
need_precedes = FALSE;
}
else
{ target_index = SearchGalley(Up(hd_index), sym, FALSE,TRUE,FALSE,FALSE);
need_precedes = (target_index != nilobj);
if( target_index == nilobj )
target_index = SearchGalley(Up(hd_index), sym, TRUE,TRUE,TRUE,FALSE);
}
/* if no luck, exit without error */
if( target_index == nilobj )
{ *inners = nilobj;
debug0(DGA, D, "] AttachGalley returning ATTACH_NOTARGET");
return ATTACH_NOTARGET;
}
}
assert( type(target_index) == RECEPTIVE, "AttachGalley: target_index!" );
target = actual(target_index);
assert( type(target) == CLOSURE, "AttachGalley: target!" );
/* set target_galley to the expanded value of target */
debug1(DYY, D, "[ EnterErrorBlock(FALSE) (expanding target %s)",
SymName(actual(target)));
EnterErrorBlock(FALSE);
New(target_galley, HEAD);
force_gall(target_galley) = FALSE;
enclose_obj(target_galley) = limiter(target_galley) = nilobj;
ClearHeaders(target_galley);
opt_components(target_galley) = opt_constraints(target_galley) = nilobj;
gall_dir(target_galley) = external_hor(target) ? COLM : ROWM;
FposCopy(fpos(target_galley), fpos(target));
actual(target_galley) = actual(target);
whereto(target_galley) = ready_galls(target_galley) = nilobj;
foll_or_prec(target_galley) = GALL_FOLL;
must_expand(target_galley) = FALSE;
sized(target_galley) = FALSE;
/* get perpendicular constraint (none if horizontal galley) */
if( dim == ROWM )
{
Constrained(target, &c, 1-dim, &junk);
if( !constrained(c) )
Error(19, 2, "receptive symbol %s has unconstrained width",
FATAL, &fpos(target), SymName(actual(target)));
debug2(DSC, DD, "Constrained( %s, 1-dim ) = %s",
EchoObject(target), EchoConstraint(&c));
if( !FitsConstraint(0, 0, c) )
{ debug0(DGA, D, " reject: target_galley horizontal constraint is -1");
y = nilobj;
goto REJECT;
}
}
else /* actually unused */
SetConstraint(c, MAX_FULL_LENGTH, MAX_FULL_LENGTH, MAX_FULL_LENGTH);
debug1(DGA, DDD, " expanding %s", EchoObject(target));
tmp = CopyObject(target, no_fpos);
Link(target_galley, tmp);
env = DetachEnv(tmp);
debug4(DGM, D, " external_ver(%s) = %s, external_hor(%s) = %s",
SymName(actual(target)), bool(external_ver(target)),
SymName(actual(target)), bool(external_hor(target)));
SizeGalley(target_galley, env,
external_ver(target) || external_hor(target),
threaded(target), non_blocking(target_index),
trigger_externs(target_index), &save_style(target),
&c, whereto(hd), &dest_index, &recs, &tg_inners,
enclose_obj(hd) != nilobj ? CopyObject(enclose_obj(hd), no_fpos):nilobj);
debug1(DGA, DD, " SizeGalley tg_inners: %s", DebugInnersNames(tg_inners));
if( recs != nilobj ) ExpandRecursives(recs);
dest = actual(dest_index);
if( underline(dest) == UNDER_UNDEF ) underline(dest) = UNDER_OFF;
/* verify that hd satisfies any horizontal constraint on dest */
if( dim == ROWM )
{
debug1(DGA, DDD, " checking hor fit of hd in %s",SymName(actual(dest)));
Constrained(dest, &c, 1-dim, &junk);
debug3(DSC, DD, "Constrained( %s, %s ) = %s",
EchoObject(dest), dimen(1-dim), EchoConstraint(&c));
assert( constrained(c), "AttachGalley: dest unconstrained!" );
if( !FitsConstraint(0, 0, c) )
{ debug0(DGA, D, " reject: hd horizontal constraint is -1");
y = nilobj;
goto REJECT;
}
}
/* manifest and size the galley if not done yet */
if( !sized(hd) )
{
debug2(DYY, D, "[ EnterErrorBlock(TRUE) (sizing galley %s into %s)",
SymName(actual(hd)), SymName(whereto(hd)));
EnterErrorBlock(TRUE);
n1 = nilobj;
Child(y, Down(hd));
env = DetachEnv(y);
/*** threaded() only defined in ROWM case
SizeGalley(hd, env, TRUE, threaded(dest), non_blocking(target_index),
TRUE, &save_style(dest), &c, nilobj, &n1, &recs, &hd_inners);
*** */
SizeGalley(hd, env, TRUE, dim == ROWM ? threaded(dest) : FALSE,
non_blocking(target_index), TRUE, &save_style(dest), &c, nilobj,
&n1, &recs, &hd_inners, nilobj);
debug1(DGA,DD," SizeGalley hd_inners: %s", DebugInnersNames(hd_inners));
if( recs != nilobj ) ExpandRecursives(recs);
if( need_precedes ) /* need an ordering constraint */
{ OBJECT index1, index2;
New(index1, PRECEDES);
New(index2, FOLLOWS);
blocked(index2) = FALSE;
tmp = MakeWord(WORD, STR_EMPTY, no_fpos);
Link(index1, tmp); Link(index2, tmp);
Link(Up(hd_index), index1);
Link(Down(hd), index2);
debug0(DGA, D, " inserting PRECEDES and FOLLOWS");
}
LeaveErrorBlock(TRUE);
debug0(DYY, D, "] LeaveErrorBlock(TRUE) (finished sizing galley)");
}
if( dim == ROWM )
{ if( !FitsConstraint(back(hd, 1-dim), fwd(hd, 1-dim), c) )
{ debug3(DGA, D, " reject: hd %s,%s does not fit target_galley %s",
EchoLength(back(hd, 1-dim)), EchoLength(fwd(hd, 1-dim)),
EchoConstraint(&c));
Error(19, 3, "too little horizontal space for galley %s at %s",
WARN, &fpos(hd), SymName(actual(hd)), SymName(actual(dest)));
goto REJECT;
}
}
/* check status of first component of hd */
debug0(DGA, DDD, " now ready to attach; hd =");
ifdebug(DGA, DDD, DebugObject(hd));
for( link = Down(hd); link != hd; link = NextDown(link) )
{
Child(y, link);
debug1(DGA, DDD, " examining %s", EchoIndex(y));
if( type(y) == SPLIT ) Child(y, DownDim(y, dim));
switch( type(y) )
{
case EXPAND_IND:
case SCALE_IND:
case COVER_IND:
case GALL_PREC:
case GALL_FOLL:
case GALL_FOLL_OR_PREC:
case GALL_TARG:
case CROSS_PREC:
case CROSS_FOLL:
case CROSS_FOLL_OR_PREC:
case CROSS_TARG:
case PAGE_LABEL_IND:
break;
case PRECEDES:
case UNATTACHED:
if( was_sized )
{ /* SizeGalley was not called, so hd_inners was not set by it */
if( hd_inners == nilobj ) New(hd_inners, ACAT);
Link(hd_inners, y);
}
break;
case RECEPTIVE:
goto SUSPEND;
case RECEIVING:
goto SUSPEND;
case FOLLOWS:
Child(tmp, Down(y));
if( Up(tmp) == LastUp(tmp) )
{ link = pred(link, CHILD);
debug0(DGA, DD, " disposing FOLLOWS");
DisposeChild(NextDown(link));
break;
}
Parent(tmp, Up(tmp));
assert(type(tmp) == PRECEDES, "Attach: PRECEDES!");
switch( CheckComponentOrder(tmp, target_index) )
{
case CLEAR: DeleteNode(tmp);
link = pred(link, CHILD);
DisposeChild(NextDown(link));
break;
case PROMOTE: break;
case BLOCK: debug0(DGA, DD, "CheckContraint: BLOCK");
goto SUSPEND;
case CLOSE: debug0(DGA, D, " reject: CheckContraint");
goto REJECT;
}
break;
case GAP_OBJ:
underline(y) = underline(dest);
if( !join(gap(y)) ) seen_nojoin(hd) = TRUE;
break;
case BEGIN_HEADER:
case END_HEADER:
case SET_HEADER:
case CLEAR_HEADER:
/* do nothing until actually promoted out of here */
underline(y) = underline(dest);
break;
case CLOSURE:
case CROSS:
case FORCE_CROSS:
case NULL_CLOS:
case PAGE_LABEL:
underline(y) = underline(dest);
break;
case WORD:
case QWORD:
case ONE_COL:
case ONE_ROW:
case WIDE:
case HIGH:
case HSHIFT:
case VSHIFT:
case HMIRROR:
case VMIRROR:
case HSCALE:
case VSCALE:
case HCOVER:
case VCOVER:
case HCONTRACT:
case VCONTRACT:
case HLIMITED:
case VLIMITED:
case HEXPAND:
case VEXPAND:
case START_HVSPAN:
case START_HSPAN:
case START_VSPAN:
case HSPAN:
case VSPAN:
case ROTATE:
case BACKGROUND:
case SCALE:
case KERN_SHRINK:
case INCGRAPHIC:
case SINCGRAPHIC:
case PLAIN_GRAPHIC:
case GRAPHIC:
case LINK_SOURCE:
case LINK_DEST:
case LINK_DEST_NULL:
case LINK_URL:
case ACAT:
case HCAT:
case VCAT:
case ROW_THR:
case COL_THR:
underline(y) = underline(dest);
if( dim == ROWM )
{
/* make sure y is not joined to a target below (vertical only) */
for( zlink = NextDown(link); zlink != hd; zlink = NextDown(zlink) )
{ Child(z, zlink);
switch( type(z) )
{
case RECEPTIVE:
if( non_blocking(z) )
{ zlink = PrevDown(zlink);
DeleteNode(z);
}
else
{ y = z;
goto SUSPEND;
}
break;
case RECEIVING:
if( non_blocking(z) )
{ zlink = PrevDown(zlink);
while( Down(z) != z )
{ Child(tmp, Down(y));
if( opt_components(tmp) != nilobj )
{ DisposeObject(opt_components(tmp));
opt_components(tmp) = nilobj;
debug3(DOG, D, "AttachGalley(%s) de-optimizing %s %s",
SymName(actual(hd)), SymName(actual(tmp)), "(join)");
}
DetachGalley(tmp);
KillGalley(tmp, FALSE);
}
DeleteNode(z);
}
else
{ y = z;
goto SUSPEND;
}
break;
case GAP_OBJ:
if( !join(gap(z)) ) zlink = PrevDown(hd);
break;
default: break;
}
}
/* if HCAT, try vertical hyphenation (vertical galleys only) */
if( type(y) == HCAT ) VerticalHyphenate(y);
}
/* check availability of parallel space for the first component */
why = nilobj;
Constrained(dest, &c, dim, &why);
debug3(DGF, DD, " dest parallel Constrained(%s, %s) = %s",
EchoObject(dest), dimen(dim), EchoConstraint(&c));
if( !FitsConstraint(back(y, dim), fwd(y, dim), c) )
{ BOOLEAN scaled;
/* if forcing galley doesn't fit, try scaling first component */
scaled = FALSE;
if( force_gall(hd) && size(y, dim) > 0 )
{ int scale_factor;
scale_factor = ScaleToConstraint(back(y,dim), fwd(y,dim), &c);
if( scale_factor > 0.5 * SF )
{ char num1[20], num2[20];
sprintf(num1, "%.1fc", (float) size(y, dim) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( dim == ROWM )
Error(19, 4, "%s object too high for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
else
Error(19, 5, "%s object too wide for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
y = InterposeScale(y, scale_factor, dim);
scaled = TRUE;
}
}
/* otherwise we must reject, and warn the user */
if( !scaled )
{ char num1[20], num2[20];
debug3(DGA, D, " reject: vsize %s,%s in %s; y=",
EchoLength(back(y, dim)), EchoLength(fwd(y, dim)),
EchoConstraint(&c));
ifdebug(DGA, D, DebugObject(y));
if( size(y, dim) > 0 )
{ sprintf(num1, "%.1fc", (float) size(y, dim) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( dim == ROWM )
Error(19, 12, "%s object too high for %s space; will try elsewhere",
WARN, &fpos(y), num1, num2);
else
Error(19, 13, "%s object too wide for %s space; will try elsewhere",
WARN, &fpos(y), num1, num2);
}
goto REJECT;
}
}
/* check availability of perpendicular space for first component */
if( dim == ROWM )
{ perp_back = back(hd, 1-dim); perp_fwd = fwd(hd, 1-dim);
}
else
{ perp_back = back(y, 1-dim); perp_fwd = fwd(y, 1-dim);
}
Constrained(dest, &c, 1-dim, &junk);
debug3(DGF, DD, " dest perpendicular Constrained(%s, %s) = %s",
EchoObject(dest), dimen(1-dim), EchoConstraint(&c));
if( !FitsConstraint(perp_back, perp_fwd, c) )
{ BOOLEAN scaled;
/* if forcing galley doesn't fit, try scaling first component */
scaled = FALSE;
if( force_gall(hd) && perp_back + perp_fwd > 0 )
{ int scale_factor;
scale_factor = ScaleToConstraint(perp_back, perp_fwd, &c);
if( scale_factor > 0.5 * SF )
{ char num1[20], num2[20];
sprintf(num1, "%.1fc", (float) (perp_back + perp_fwd) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( 1-dim == ROWM )
Error(19, 6, "%s object too high for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
else
Error(19, 7, "%s object too wide for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
y = InterposeScale(y, scale_factor, 1-dim);
scaled = TRUE;
}
}
/* otherwise we must reject, and warn the user */
if( !scaled )
{
debug3(DGA, D, " reject: vsize %s,%s in %s; y=",
EchoLength(perp_back), EchoLength(perp_fwd),
EchoConstraint(&c));
ifdebug(DGA, D, DebugObject(y));
goto REJECT;
}
}
/* dest seems OK, so perform its size adjustments */
debug0(DSA, D, "calling AdjustSize from AttachGalley (a)");
AdjustSize(dest, back(y, dim), fwd(y, dim), dim);
debug0(DSA, D, "calling AdjustSize from AttachGalley (b)");
AdjustSize(dest, perp_back, perp_fwd, 1-dim);
/* now check parallel space for target_galley in target */
Constrained(target, &c, dim, &why);
debug3(DGF, DD, " target parallel Constrained(%s, %s) = %s",
EchoObject(target), dimen(dim), EchoConstraint(&c));
Child(z, LastDown(target_galley)); /* works in all cases? */
assert( !is_index(type(z)), "AttachGalley: is_index(z)!" );
assert( back(z, dim)>=0 && fwd(z, dim)>=0, "AttachGalley: z size!" );
if( !FitsConstraint(back(z, dim), fwd(z, dim), c) )
{ BOOLEAN scaled;
debug2(DGA, D, " why = %d %s", (int) why, EchoObject(why));
debug2(DGA, D, " limiter = %d %s", (int) limiter(hd),
EchoObject(limiter(hd)));
/* if forcing galley doesn't fit, try scaling z */
scaled = FALSE;
if( force_gall(hd) && size(z, dim) > 0 && limiter(hd) != why )
{ int scale_factor;
scale_factor = ScaleToConstraint(back(z,dim), fwd(z,dim), &c);
if( scale_factor > 0.5 * SF )
{ char num1[20], num2[20];
sprintf(num1, "%.1fc", (float) size(z, dim) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( dim == ROWM )
Error(19, 8, "%s object too high for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
else
Error(19, 9, "%s object too wide for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
z = InterposeWideOrHigh(z, dim);
z = InterposeScale(z, scale_factor, dim);
scaled = TRUE;
}
}
if( !scaled )
{ char num1[20], num2[20];
limiter(hd) = why;
debug3(DGA, D, " set limiter(%s) = %d %s", SymName(actual(hd)),
(int) limiter(hd), EchoObject(limiter(hd)));
debug3(DGA, D, " reject: size was %s,%s in %s; y =",
EchoLength(back(z, dim)), EchoLength(fwd(z, dim)),
EchoConstraint(&c));
ifdebug(DGA, D, DebugObject(y));
if( size(z, dim) > 0 )
{ sprintf(num1, "%.1fc", (float) size(z, dim) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( dim == ROWM )
Error(19, 14, "%s object too high for %s space; will try elsewhere",
WARN, &fpos(y), num1, num2);
else
Error(19, 15, "%s object too wide for %s space; will try elsewhere",
WARN, &fpos(y), num1, num2);
}
goto REJECT;
}
}
limiter(hd) = why;
debug3(DGA, D, " set limiter(%s) = %d %s", SymName(actual(hd)),
(int) limiter(hd), EchoObject(limiter(hd)));
/* now check perpendicular space for target_galley in target */
Constrained(target, &c, 1-dim, &junk);
debug3(DGF, DD, " target perpendicular Constrained(%s, %s) = %s",
EchoObject(target), dimen(1-dim), EchoConstraint(&c));
Child(z, LastDown(target_galley)); /* works in all cases? */
assert( !is_index(type(z)), "AttachGalley: is_index(z)!" );
assert( back(z, 1-dim)>=0 && fwd(z, 1-dim)>=0,
"AttachGalley: z size (perpendicular)!" );
if( !FitsConstraint(back(z, 1-dim), fwd(z, 1-dim), c) )
{ BOOLEAN scaled;
/* if forcing galley doesn't fit, try scaling z */
scaled = FALSE;
if( force_gall(hd) && size(z, 1-dim) > 0 )
{ int scale_factor;
scale_factor = ScaleToConstraint(back(z,1-dim), fwd(z,1-dim), &c);
if( scale_factor > 0.5 * SF )
{ char num1[20], num2[20];
sprintf(num1, "%.1fc", (float) size(z, 1-dim) / CM);
sprintf(num2, "%.1fc", (float) bfc(c) / CM);
if( 1-dim == ROWM )
Error(19, 10, "%s object too high for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
else
Error(19, 11, "%s object too wide for %s space; %s inserted",
WARN, &fpos(y), num1, num2, KW_SCALE);
z = InterposeWideOrHigh(z, 1-dim);
z = InterposeScale(z, scale_factor, 1-dim);
scaled = TRUE;
}
}
if( !scaled )
{
debug3(DGA, D, " reject: size was %s,%s in %s; y =",
EchoLength(back(z, 1-dim)), EchoLength(fwd(z, 1-dim)),
EchoConstraint(&c));
ifdebug(DGA, D, DebugObject(y));
goto REJECT;
}
}
/* target seems OK, so adjust sizes and accept */
if( external_hor(target) )
{
/* don't adjust any sizes, none to adjust */
debug0(DSA, D, "not calling AdjustSize from AttachGalley (c)");
}
else if( external_ver(target) )
{
/* adjust perp size only, to galley size */
debug0(DSA, D, "calling AdjustSize from AttachGalley (d)");
AdjustSize(target, back(target_galley, 1-dim),
fwd(target_galley, 1-dim), 1-dim);
}
else
{
/* adjust both directions, using z (last component) */
Child(z, LastDown(target_galley));
debug0(DSA, D, "AttachGalley AdjustSize using z =");
ifdebug(DSA, D, DebugObject(z));
debug0(DSA, D, "calling AdjustSize from AttachGalley (e)");
AdjustSize(target, back(z, dim), fwd(z, dim), dim);
debug0(DSA, D, "calling AdjustSize from AttachGalley (f)");
AdjustSize(target, back(z, 1-dim), fwd(z, 1-dim), 1-dim);
}
goto ACCEPT;
default:
assert1(FALSE, "AttachGalley:", Image(type(y)));
break;
} /* end switch */
} /* end for */
/* null galley: promote whole galley without expanding the target */
debug0(DGA, D, " null galley");
if( tg_inners != nilobj ) DisposeObject(tg_inners), tg_inners = nilobj;
DisposeObject(target_galley);
LeaveErrorBlock(FALSE);
debug0(DYY, D, "] LeaveErrorBlock(FALSE) (null galley)");
/* kill off any null objects within the galley, then transfer it */
/* don't use Promote() since it does extra unwanted things here */
for( link = Down(hd); link != hd; link = NextDown(link) )
{ Child(y, link);
switch( type(y) )
{
case GAP_OBJ:
case CLOSURE:
case CROSS:
case FORCE_CROSS:
case NULL_CLOS:
case PAGE_LABEL:
link = PrevDown(link);
debug1(DGA, D, " null galley, disposing %s", Image(type(y)));
DisposeChild(NextDown(link));
break;
default:
break;
}
}
TransferLinks(NextDown(hd), hd, Up(target_index));
/* attach hd temporarily to target_index */
MoveLink(Up(hd), target_index, PARENT);
assert( type(hd_index) == UNATTACHED, "AttachGalley: type(hd_index)!" );
DeleteNode(hd_index);
/* return; only hd_inners needs to be flushed now */
*inners = hd_inners;
debug0(DGA, D, "] AttachGalley returning ATTACH_NULL");
return ATTACH_NULL;
REJECT:
/* reject first component */
/* debug1(DGA, D, " reject %s", EchoObject(y)); */
debug0(DGA, D, " reject first component");
LeaveErrorBlock(TRUE);
debug0(DYY, D, "] LeaveErrorBlock(TRUE) (REJECT)");
if( tg_inners != nilobj ) DisposeObject(tg_inners), tg_inners = nilobj;
DisposeObject(target_galley);
if( foll_or_prec(hd) == GALL_PREC && !sized(hd) )
{
/* move to just before the failed target */
MoveLink(Up(hd_index), Up(target_index), PARENT);
}
else
{
/* move to just after the failed target */
MoveLink(Up(hd_index), NextDown(Up(target_index)), PARENT);
}
continue;
SUSPEND:
/* suspend at first component */
debug1(DGA, D, " suspend %s", EchoIndex(y));
blocked(y) = TRUE;
LeaveErrorBlock(FALSE);
debug0(DYY, D, "] LeaveErrorBlock(FALSE) (SUSPEND)");
if( tg_inners != nilobj ) DisposeObject(tg_inners), tg_inners = nilobj;
DisposeObject(target_galley);
MoveLink(Up(hd_index), Up(target_index), PARENT);
if( was_sized )
{ /* nothing new to flush if suspending and already sized */
if( hd_inners != nilobj ) DisposeObject(hd_inners), hd_inners=nilobj;
*inners = nilobj;
}
else
{ /* flush newly discovered inners if not sized before */
*inners = hd_inners;
}
debug0(DGA, D, "] AttachGalley returning ATTACH_SUSPEND");
*suspend_pt = y;
return ATTACH_SUSPEND;
ACCEPT:
/* accept first component; now committed to the attach */
debug3(DGA, D, " accept %s %s %s", Image(type(y)), EchoObject(y),
EchoFilePos(&fpos(y)));
LeaveErrorBlock(TRUE);
debug0(DYY, D, "] LeaveErrorBlock(TRUE) (ACCEPT)");
/* attach hd to dest */
MoveLink(Up(hd), dest_index, PARENT);
assert( type(hd_index) == UNATTACHED, "AttachGalley: type(hd_index)!" );
DeleteNode(hd_index);
/* move first component of hd into dest */
/* nb Interpose must be done after all AdjustSize calls */
if( dim == ROWM && !external_ver(dest) )
Interpose(dest, VCAT, hd, y);
else if( dim == COLM && !external_hor(dest) )
{ Interpose(dest, ACAT, y, y);
Parent(junk, Up(dest));
assert( type(junk) == ACAT, "AttachGalley: type(junk) != ACAT!" );
StyleCopy(save_style(junk), save_style(dest));
adjust_cat(junk) = padjust(save_style(junk));
}
debug1(DGS, D, "calling Promote(hd, %s) from AttachGalley/ACCEPT",
link == hd ? "hd" : "NextDown(link)");
Promote(hd, link == hd ? hd : NextDown(link), dest_index, TRUE);
/* move target_galley into target */
/* nb Interpose must be done after all AdjustSize calls */
if( !(external_ver(target) || external_hor(target)) )
{ Child(z, LastDown(target_galley));
Interpose(target, VCAT, z, z);
}
debug0(DGS, D, "calling Promote(target_galley) from AttachGalley/ACCEPT");
Promote(target_galley, target_galley, target_index, TRUE);
DeleteNode(target_galley);
assert(Down(target_index)==target_index, "AttachGalley: target_ind");
if( blocked(target_index) ) blocked(dest_index) = TRUE;
DeleteNode(target_index);
/* return; both tg_inners and hd_inners need to be flushed now; */
/* if was_sized, hd_inners contains the inners of the first component; */
/* otherwise it contains the inners of all components, from SizeGalley */
if( tg_inners == nilobj ) *inners = hd_inners;
else if( hd_inners == nilobj ) *inners = tg_inners;
else
{ TransferLinks(Down(hd_inners), hd_inners, tg_inners);
DeleteNode(hd_inners);
*inners = tg_inners;
}
debug0(DGA, D, "] AttachGalley returning ATTACH_ACCEPT");
ifdebug(DGA, D,
if( dim == COLM && !external_hor(dest) )
{ OBJECT z;
Parent(z, Up(dest));
debug2(DGA, D, " COLM dest_encl on exit = %s %s",
Image(type(z)), EchoObject(z));
}
)
return ATTACH_ACCEPT;
} /* end for */
void FlushGalley(OBJECT hd)
{ OBJECT dest; /* the target galley hd empties into */
OBJECT dest_index; /* the index of dest */
OBJECT inners; /* list of galleys and PRECEDES to flush */
OBJECT link, y; /* for scanning through the components of hd */
int dim; /* direction of galley */
CONSTRAINT dest_par_constr; /* the parallel size constraint on dest */
CONSTRAINT dest_perp_constr; /* the perpendicular size constraint on dest */
int pb, pf, f; /* candidate replacement sizes for dest */
OBJECT dest_encl; /* the VCAT or ACAT enclosing dest, if any */
int dest_side; /* if dest_encl != nilobj, side dest is on */
BOOLEAN need_adjust; /* TRUE as soon as dest_encl needs adjusting */
FULL_LENGTH dest_back, dest_fwd; /* the current size of dest_encl or dest */
FULL_LENGTH frame_size; /* the total constraint of dest_encl */
OBJECT prec_gap; /* the gap preceding dest if any else nilobj */
OBJECT prec_def; /* the component preceding dest, if any */
OBJECT succ_gap; /* the gap following dest if any else nilobj */
OBJECT succ_def; /* the component following dest, if any */
OBJECT stop_link; /* most recently seen gap link of hd */
FULL_LENGTH stop_back; /* back(dest_encl) incl all before stop_link */
FULL_LENGTH stop_fwd; /* fwd(dest_encl) incl. all before stop_link */
FULL_LENGTH stop_perp_back; /* back(dest_encl) in other direction */
FULL_LENGTH stop_perp_fwd; /* fwd(dest_encl) in other direction */
BOOLEAN prnt_flush; /* TRUE when the parent of hd needs a flush */
BOOLEAN target_is_internal; /* TRUE if flushing into an internal target */
BOOLEAN headers_seen; /* TRUE if a header is seen at all */
OBJECT zlink, z, tmp, prnt; int attach_status; BOOLEAN remove_target;
OBJECT why;
FULL_LENGTH perp_back, perp_fwd; /* current perp size of dest_encl */
debug1(DGF, D, "[ FlushGalley %s (hd)", SymName(actual(hd)));
prnt_flush = FALSE;
dim = gall_dir(hd);
RESUME:
assert( type(hd) == HEAD, "FlushGalley: type(hd) != HEAD!" );
debug1(DGF, D, " resuming FlushGalley %s, hd =", SymName(actual(hd)));
ifdebugcond(DGF, DD, actual(hd) == nilobj, DebugGalley(hd, nilobj, 4));
assert( Up(hd) != hd, "FlushGalley: resume found no parent to hd!" );
/*@@************************************************************************/
/* */
/* The first step is to examine the parent of galley hd to determine the */
/* status of the galley. If this is not suitable for flushing, we do */
/* what we can to change the status. If still no good, return; so if */
/* this code does not return, then the galley is ready to flush into a */
/* destination in the normal way, and the following variables are set: */
/* */
/* dest_index the parent of the galley and index of its destination */
/* dest the destination of the galley, a @Galley object */
/* */
/***************************************************************************/
Parent(dest_index, Up(hd));
switch( type(dest_index) )
{
case DEAD:
/* the galley has been killed off while this process was sleeping */
debug1(DGF, D, "] FlushGalley %s returning (DEAD)", SymName(actual(hd)));
return;
case UNATTACHED:
/* the galley is currently not attached to a destination */
attach_status = AttachGalley(hd, &inners, &y);
debug1(DGF, DD, " ex-AttachGalley inners: %s", DebugInnersNames(inners));
Parent(dest_index, Up(hd));
switch( attach_status )
{
case ATTACH_KILLED:
assert(inners==nilobj, "FlushGalley/ATTACH_KILLED: inners!=nilobj!");
debug1(DGF, D, "] FlushGalley %s returning (ATTACH_KILLED)",
SymName(actual(hd)));
debug1(DGF, D, " prnt_flush = %s", bool(prnt_flush));
return;
case ATTACH_INPUT:
ParentFlush(prnt_flush, dest_index, FALSE);
assert(inners==nilobj, "FlushGalley/ATTACH_INPUT: inners!=nilobj!");
debug1(DGF, D, "] FlushGalley %s returning (ATTACH_INPUT)",
SymName(actual(hd)));
return;
case ATTACH_NOTARGET:
ParentFlush(prnt_flush, dest_index, FALSE);
assert(inners==nilobj, "FlushGalley/ATTACH_NOTARG: inners!=nilobj!");
debug1(DGF, D, "] FlushGalley %s returning (ATTACH_NOTARGET)",
SymName(actual(hd)));
return;
case ATTACH_SUSPEND:
/* AttachGalley only returns inners here if they really need to */
/* be flushed; in particular the galley must be unsized before */
if( inners != nilobj )
{
debug0(DGF, DD, " calling FlushInners() from FlushGalley (a)");
FlushInners(inners, nilobj);
goto RESUME;
}
stop_link = nilobj;
goto SUSPEND; /* nb y will be set by AttachGalley in this case */
case ATTACH_NULL:
/* hd will have been linked to the unexpanded target in this case */
remove_target = (actual(actual(dest_index)) == whereto(hd));
if( force_gall(hd) )
{
/* if hd is a forcing galley, close all predecessors */
debug3(DGA, D, " forcing ATTACH_NULL case for %s into %s (%s)",
SymName(actual(hd)), SymName(whereto(hd)),
remove_target ? "remove_target" : "not remove_target");
Parent(prnt, Up(dest_index));
if( !non_blocking(dest_index) && remove_target )
{
/* ***
prnt_flush = TRUE;
*** */
prnt_flush = non_blocking(dest_index) = TRUE;
}
FreeGalley(prnt, Up(dest_index), &inners, Up(dest_index),
whereto(hd));
}
else
{
debug3(DGA, D, " non-force ATTACH_NULL case for %s into %s (%s)",
SymName(actual(hd)), SymName(whereto(hd)),
remove_target ? "remove_target" : "not remove_target");
if( blocked(dest_index) && remove_target ) prnt_flush = TRUE;
}
DetachGalley(hd);
KillGalley(hd, TRUE);
if( inners != nilobj )
{
debug0(DGF, DD, " calling FlushInners() from FlushGalley (b)");
FlushInners(inners, nilobj);
}
else ParentFlush(prnt_flush, dest_index, remove_target);
debug0(DGF, D, "] FlushGalley returning ATTACH_NULL");
return;
case ATTACH_ACCEPT:
/* if hd is a forcing galley, or actual(dest_index) is */
/* @ForceGalley, then close all predecessors */
if( force_gall(hd) || actual(actual(dest_index)) == ForceGalleySym )
{ Parent(prnt, Up(dest_index));
debug1(DGA, D, " forcing ATTACH_ACCEPT case for %s",
SymName(actual(hd)));
/* debug0(DGA, DD, " force: prnt ="); */
/* ifdebug(DGA, DD, DebugObject(prnt)); */
/* debug1(DGA, D," calling FreeGalley from FlushGalley(%s)", */
/* SymName(actual(hd))); */
if( !non_blocking(dest_index) ) prnt_flush = TRUE; /* bug fix */
FreeGalley(prnt, Up(dest_index), &inners, Up(dest_index),
whereto(hd));
/* debug0(DGA, DD, " force: after FreeGalley, prnt ="); */
/* ifdebug(DGA, DD, DebugObject(prnt)); */
}
else prnt_flush = prnt_flush || blocked(dest_index);
debug1(DGF, DD, " force: prnt_flush = %s", bool(prnt_flush));
if( inners != nilobj )
{
debug0(DGF, DD, " calling FlushInners() from FlushGalley (c)");
FlushInners(inners, nilobj);
}
goto RESUME;
default:
assert(FALSE, "FlushGalley: attach_status");
break;
}
break;
case RECEIVING:
if( actual(actual(dest_index)) == InputSym )
{ ParentFlush(prnt_flush, dest_index, FALSE);
debug1(DGF, D, "] FlushGalley %s retn, input", SymName(actual(hd)));
return;
}
break;
default:
assert1(FALSE, "FlushGalley: dest_index", Image(type(dest_index)));
break;
}
dest = actual(dest_index);
if( underline(dest) == UNDER_UNDEF ) underline(dest) = UNDER_OFF;
target_is_internal =
(dim==ROWM && !external_ver(dest)) || (dim==COLM && !external_hor(dest));
headers_seen = FALSE;
debug1(DGF, DD, " dest_index: %s", EchoObject(dest_index));
/*@@************************************************************************/
/* */
/* The second step is to examine the components of the galley one by one */
/* to determine if they can be promoted. Each component has the format */
/* */
/* { <index> } <object> */
/* */
/* and is always followed by a gap object (except the last component). */
/* An index indicates that the following object has some interesting */
/* feature, and it points to that feature inside the object. There are */
/* two possible actions for each component, in addition to accepting it: */
/* */
/* REJECT: The component does not fit, so detach the galley */
/* SUSPEND: The component is incomplete; go to sleep and wait */
/* */
/***************************************************************************/
stop_link = dest_encl = inners = nilobj;
need_adjust = FALSE;
/***************************************************************************/
/* */
/* Loop invariant */
/* */
/* The children of hd up to but not including Child(link) have been */
/* examined and pronounced to be promotable, if unbreakable gaps are */
/* ignored. When unbreakable gaps are taken into account, the most */
/* recent gap where a break is possible is at Child(stop_link), or */
/* nowhere if stop_link == nilobj. */
/* */
/* Case 1: target_is_internal == FALSE */
/* */
/* If this flag is FALSE, it means that the target of this galley is */
/* external. Consequently, there is no need to calculate sizes because */
/* there is no constraint on them. Also, a REJECT action is impossible */
/* so unbreakable gaps are no impediment. Variable dest_encl is nilobj. */
/* */
/* Case 2: target_is_internal == TRUE */
/* */
/* If this flag is TRUE, it means that the target of this galley is */
/* internal. Consequently, sizes need to be calculated, and unbreakable */
/* gaps need to be taken into account. Variable dest_encl may be not */
/* nilobj, in which case the following variables are defined: */
/* */
/* dest_encl the object enclosing dest (which must exist) */
/* prec_gap gap object preceding dest (which must exist) */
/* prec_def first definite object preceding dest (must exist) */
/* dest_back back(dest_encl) including effect of accepted compts */
/* dest_fwd fwd(dest_encl) including effect of accepted compts */
/* dest_side BACK or FWD, i.e. which side of the mark dest is on */
/* dest_par_constr the parallel size constraint on dest */
/* dest_perp_constr the perpendicular size constraint on dest */
/* frame_size size of frame enclosing dest_encl */
/* perp_back back(dest_encl) in other direction, incl accepteds */
/* perp_fwd fwd(dest_encl) in other direction, incl accepteds */
/* */
/* if dest_encl is nilobj, these variables are not defined. */
/* */
/* If stop_link is non-nilobj, then in the internal case dest_encl must */
/* be non-nilobj, and the following variables are defined: */
/* */
/* stop_back back(dest_encl) including all before stop_link */
/* stop_fwd fwd(dest_encl) including all before stop_link */
/* stop_perp_back back(dest_encl) in other direction */
/* stop_perp_fwd fwd(dest_encl) in other direction */
/* */
/* need_adjust is true if at least one definite component has been */
/* accepted for promotion and the destination is internal; hence, */
/* dest_encl is defined and its size needs to be adjusted. */
/* */
/* inners is the set of all PRECEDES and UNATTACHED indexes found. */
/* */
/***************************************************************************/
for( link = Down(hd); link != hd; link = NextDown(link) )
{
Child(y, link);
if( type(y) == SPLIT ) Child(y, DownDim(y, dim));
debug2(DGF, DD, " examining %s %s", Image(type(y)), EchoObject(y));
switch( type(y) )
{
case GAP_OBJ:
underline(y) = underline(dest);
prec_gap = y;
if( target_is_internal )
{
/* *** not necessarily true
assert( dest_encl != nilobj, "FlushGalley/GAP_OBJ: dest_encl!" );
*** */
if( dest_encl != nilobj && !nobreak(gap(prec_gap)) )
{
stop_link = link;
stop_back = dest_back;
stop_fwd = dest_fwd;
stop_perp_back = perp_back;
stop_perp_fwd = perp_fwd;
}
}
else stop_link = link;
if( !join(gap(y)) ) seen_nojoin(hd) = TRUE;
break;
case SCALE_IND:
case COVER_IND:
case EXPAND_IND:
case GALL_PREC:
case GALL_FOLL:
case GALL_FOLL_OR_PREC:
case GALL_TARG:
case CROSS_PREC:
case CROSS_FOLL:
case CROSS_FOLL_OR_PREC:
case CROSS_TARG:
case PAGE_LABEL_IND:
underline(y) = underline(dest);
break;
case PRECEDES:
case UNATTACHED:
if( inners == nilobj ) New(inners, ACAT);
Link(inners, y);
break;
case RECEIVING:
case RECEPTIVE:
goto SUSPEND;
case FOLLOWS:
Child(tmp, Down(y));
if( Up(tmp) == LastUp(tmp) )
{ link = PrevDown(link);
DisposeChild(NextDown(link));
break;
}
Parent(tmp, Up(tmp));
assert(type(tmp) == PRECEDES, "Flush: PRECEDES!");
switch( CheckComponentOrder(tmp, dest_index) )
{
case CLEAR: DeleteNode(tmp);
link = PrevDown(link);
DisposeChild(NextDown(link));
break;
case PROMOTE: break;
case BLOCK: goto SUSPEND;
case CLOSE: if( opt_components(hd) != nilobj )
{ DisposeObject(opt_components(hd));
opt_components(hd) = nilobj;
debug2(DOG, D, "FlushGalley(%s) de-optimizing %s",
"(CLOSE problem)", SymName(actual(hd)));
}
debug1(DGF, DD, " reject (a) %s", EchoObject(y));
goto REJECT;
}
break;
case BEGIN_HEADER:
case END_HEADER:
case SET_HEADER:
case CLEAR_HEADER:
/* do nothing except take note, until actually promoted out of here */
headers_seen = TRUE;
break;
case NULL_CLOS:
case PAGE_LABEL:
case WORD:
case QWORD:
case ONE_COL:
case ONE_ROW:
case WIDE:
case HIGH:
case HSHIFT:
case VSHIFT:
case HSCALE:
case VSCALE:
case HCOVER:
case VCOVER:
case HCONTRACT:
case VCONTRACT:
case HLIMITED:
case VLIMITED:
case HEXPAND:
case VEXPAND:
case START_HVSPAN:
case START_HSPAN:
case START_VSPAN:
case HSPAN:
case VSPAN:
case ROTATE:
case BACKGROUND:
case SCALE:
case KERN_SHRINK:
case INCGRAPHIC:
case SINCGRAPHIC:
case PLAIN_GRAPHIC:
case GRAPHIC:
case LINK_SOURCE:
case LINK_DEST:
case ACAT:
case HCAT:
case VCAT:
case ROW_THR:
case CLOSURE:
case CROSS:
case FORCE_CROSS:
underline(y) = underline(dest);
if( dim == ROWM )
{
/* make sure y is not joined to a target below (vertical case only) */
for( zlink = NextDown(link); zlink != hd; zlink = NextDown(zlink) )
{ Child(z, zlink);
switch( type(z) )
{
case RECEPTIVE:
case RECEIVING: y = z;
goto SUSPEND;
case GAP_OBJ: if( !join(gap(z)) ) zlink = PrevDown(hd);
break;
default: break;
}
}
/* try vertical hyphenation before anything else */
if( type(y) == HCAT ) VerticalHyphenate(y);
}
/* check size constraint */
if( target_is_internal )
{
/* initialise dest_encl etc if not done yet */
if( dest_encl == nilobj )
{ assert( UpDim(dest,1-dim) == UpDim(dest,dim), "FlushG: UpDims!" );
/* *** weird old code, trying for UpDim(dest, ROWM)?
Parent(dest_encl, NextDown(Up(dest)));
*** */
Parent(dest_encl, Up(dest));
debug4(DGF, DD, " flush dest = %s %s, dest_encl = %s %s",
Image(type(dest)), EchoObject(dest),
Image(type(dest_encl)), EchoObject(dest_encl));
assert( (dim==ROWM && type(dest_encl)==VCAT) ||
(dim==COLM && type(dest_encl)==ACAT),
"FlushGalley: dest != VCAT or ACAT!" );
SetNeighbours(Up(dest), FALSE, &prec_gap, &prec_def,
&succ_gap, &succ_def, &dest_side);
assert(prec_gap != nilobj || is_indefinite(type(y)),
"FlushGalley: prec_gap == nilobj && !is_indefinite(type(y))!" );
assert(succ_gap == nilobj, "FlushGalley: succ_gap != nilobj!" );
assert(dest_side == FWD || is_indefinite(type(y)),
"FlushGalley: dest_side != FWD || !is_indefinite(type(y))!");
dest_back = back(dest_encl, dim);
dest_fwd = fwd(dest_encl, dim);
perp_back = back(dest_encl, 1-dim);
perp_fwd = fwd(dest_encl, 1-dim);
Constrained(dest_encl, &dest_par_constr, dim, &why);
Constrained(dest_encl, &dest_perp_constr, 1-dim, &why);
debug1(DGF, DD, " setting dest_perp_constr = %s",
EchoConstraint(&dest_perp_constr));
frame_size = constrained(dest_par_constr) ? bfc(dest_par_constr) :0;
}
if( !is_indefinite(type(y)) )
{
ifdebugcond(DGF, DD, mode(gap(prec_gap)) == NO_MODE,
DebugGalley(hd, y, 4));
/* calculate parallel effect of adding y to dest */
f = dest_fwd + fwd(y, dim) - fwd(prec_def, dim) +
ActualGap(fwd(prec_def, dim), back(y, dim),
fwd(y, dim), &gap(prec_gap), frame_size,
dest_back + dest_fwd - fwd(prec_def, dim));
debug5(DGF, DD, " f = %s + %s - %s + %s (prec_gap %s)",
EchoLength(dest_fwd), EchoLength(fwd(y, dim)),
EchoLength(fwd(prec_def, dim)), EchoLength(
ActualGap(fwd(prec_def, dim), back(y, dim),
fwd(y, dim), &gap(prec_gap), frame_size,
dest_back + dest_fwd - fwd(prec_def, dim))
), EchoGap(&gap(prec_gap)));
debug3(DGF, DD, " b,f: %s,%s; dest_encl: %s",
EchoLength(dest_back), EchoLength(f),
EchoConstraint(&dest_par_constr));
/* check new size against parallel constraint */
if( (units(gap(prec_gap))==FRAME_UNIT && width(gap(prec_gap)) > FR)
|| !FitsConstraint(dest_back, f, dest_par_constr)
|| (opt_components(hd) != nilobj && opt_comps_permitted(hd)<=0)
)
{
if( opt_components(hd) != nilobj )
{ OBJECT z;
/* record the size of this just-completed target area for hd */
New(z, WIDE);
CopyConstraint(constraint(z), dest_par_constr);
Link(opt_constraints(hd), z);
ifdebug(DOG, D,
debug2(DOG, D, "FlushGalley(%s) adding constraint %s",
SymName(actual(hd)), EchoConstraint(&constraint(z)));
if( units(gap(prec_gap))==FRAME_UNIT &&
width(gap(prec_gap)) > FR )
{ debug1(DOG, D, " prec_gap = %s", EchoGap(&gap(prec_gap)));
}
if( !FitsConstraint(dest_back, f, dest_par_constr) )
{ debug3(DOG, D, " !FitsConstraint(%s, %s, %s)",
EchoLength(dest_back), EchoLength(f),
EchoConstraint(&dest_par_constr));
}
if( opt_comps_permitted(hd) <= 0 )
{ debug1(DOG, D, " opt_comps_permitted = %2d",
opt_comps_permitted(hd));
}
debug4(DOG, D, "prec_gap = %s; y = %s (%s,%s):",
EchoGap(&gap(prec_gap)), Image(type(y)),
EchoLength(back(y, dim)), EchoLength(fwd(y, dim)));
DebugObject(y);
)
/* refresh the number of components permitted into the next target */
if( opt_counts(hd) != nilobj && Down(opt_counts(hd)) != opt_counts(hd) )
{ Child(z, Down(opt_counts(hd)));
opt_comps_permitted(hd) += comp_count(z) - 1;
DisposeChild(Up(z));
}
else opt_comps_permitted(hd) = MAX_FILES; /* a large number */
debug1(DOG, D, " REJECT permitted = %2d", opt_comps_permitted(hd));
}
debug1(DGF, DD, " reject (b) %s", EchoObject(y));
goto REJECT;
}
/* calculate perpendicular effect of adding y to dest */
if( seen_nojoin(hd) )
{
pb = 0;
pf = find_max(perp_fwd, size(y, 1-dim));
}
else
{
pb = find_max(perp_back, back(y, 1-dim));
pf = find_max(perp_fwd, fwd(y, 1-dim));
}
/* check new size against perpendicular constraint */
if( !FitsConstraint(pb, pf, dest_perp_constr) )
{
if( opt_components(hd) != nilobj )
{ DisposeObject(opt_components(hd));
opt_components(hd) = nilobj;
debug1(DOG, D, "FlushGalley(%s) de-optimizing (perp problem)",
SymName(actual(hd)));
}
if( dim == ROWM )
{
Error(20, 3, "component too wide for available space",
WARN, &fpos(y));
debug6(DGF, DD, " %s,%s [%s,%s] too wide for %s, y = %s",
EchoLength(pb), EchoLength(pf),
EchoLength(back(y, 1-dim)), EchoLength(fwd(y, 1-dim)),
EchoConstraint(&dest_perp_constr), EchoObject(y));
}
debug1(DGF, DD, " reject (c) %s", EchoObject(y));
goto REJECT;
}
/* accept definite component */
dest_fwd = f; prec_def = y;
perp_back = pb; perp_fwd = pf;
need_adjust = TRUE;
if( opt_components(hd) != nilobj )
{ opt_comps_permitted(hd)--;
debug1(DOG, D, " ACCEPT permitted = %2d", opt_comps_permitted(hd));
}
}
/* accept indefinite component */
} /* end if( target_is_internal ) */
static void ReadTokenList(OBJECT token, OBJECT res)
{ OBJECT t, xsym, new_par, imps, link, y; int scope_count, i;
NextToken(t, res);
for(;;) switch(type(t))
{
case WORD:
if( string(t)[0] == CH_SYMSTART )
Error(5, 11, "symbol %s unknown or misspelt", WARN, &fpos(t),
string(t));
NextToken(t, res);
break;
case QWORD:
NextToken(t, res);
break;
case VCAT:
case HCAT:
case ACAT:
case CROSS:
case FORCE_CROSS:
case NULL_CLOS:
case PAGE_LABEL:
case BEGIN_HEADER:
case END_HEADER:
case SET_HEADER:
case CLEAR_HEADER:
case ONE_COL:
case ONE_ROW:
case WIDE:
case HIGH:
case HSHIFT:
case VSHIFT:
case HMIRROR:
case VMIRROR:
case HSCALE:
case VSCALE:
case HCOVER:
case VCOVER:
case SCALE:
case KERN_SHRINK:
case HCONTRACT:
case VCONTRACT:
case HLIMITED:
case VLIMITED:
case HEXPAND:
case VEXPAND:
case START_HVSPAN:
case START_HSPAN:
case START_VSPAN:
case HSPAN:
case VSPAN:
case PADJUST:
case HADJUST:
case VADJUST:
case ROTATE:
case BACKGROUND:
case RAW_VERBATIM:
case VERBATIM:
case CASE:
case YIELD:
case BACKEND:
case XCHAR:
case FONT:
case SPACE:
case YUNIT:
case ZUNIT:
case SET_CONTEXT:
case GET_CONTEXT:
case BREAK:
case UNDERLINE:
case UNDERLINE_COLOUR:
case COLOUR:
case TEXTURE:
case OUTLINE:
case LANGUAGE:
case CURR_LANG:
case CURR_FAMILY:
case CURR_FACE:
case CURR_YUNIT:
case CURR_ZUNIT:
case COMMON:
case RUMP:
case MELD:
case INSERT:
case ONE_OF:
case NEXT:
case PLUS:
case MINUS:
case TAGGED:
case INCGRAPHIC:
case SINCGRAPHIC:
case PLAIN_GRAPHIC:
case GRAPHIC:
case LINK_SOURCE:
case LINK_DEST:
case LINK_DEST_NULL:
case LINK_URL:
case NOT_REVEALED:
NextToken(t, res);
break;
case LUSE:
case LVIS:
case ENV:
case USE:
case DATABASE:
case SYS_DATABASE:
case PREPEND:
case SYS_PREPEND:
case INCG_REPEATED:
case SINCG_REPEATED:
case OPEN:
Error(5, 12, "symbol %s not allowed in macro", WARN, &fpos(t),
SymName(actual(t)));
NextToken(t, res);
break;
case LBR:
ReadTokenList(t, res);
NextToken(t, res);
break;
case UNEXPECTED_EOF:
Error(5, 13, "unexpected end of input", FATAL, &fpos(t));
break;
case BEGIN:
Error(5, 14, "%s not expected here", WARN, &fpos(t), SymName(actual(t)));
NextToken(t, res);
break;
case RBR:
if( type(token) != LBR )
Error(5, 15, "unmatched %s in macro", WARN, &fpos(t), KW_RBR);
return;
case END:
if( type(token) != BEGIN )
Error(5, 16, "unmatched %s in macro", WARN, &fpos(t), KW_END);
else
{ NextToken(t, res);
if( type(t) != CLOSURE )
{
if( type(t) == WORD && string(t)[0] == CH_SYMSTART )
Error(5, 17, "symbol %s unknown or misspelt",
WARN, &fpos(t), string(t));
else
Error(5, 18, "symbol name expected after %s", WARN,&fpos(t),KW_END);
}
else if( actual(token) != actual(t) )
Error(5, 19, "%s %s does not match %s %s", WARN, &fpos(t),
SymName(actual(token)), KW_BEGIN, SymName(actual(t)), KW_END);
}
return;
case CLOSURE:
xsym = actual(t);
PushScope(xsym, TRUE, FALSE);
NextToken(t, res);
PopScope();
if( type(t) == CROSS || type(t) == FORCE_CROSS )
{ NextToken(t, res);
break;
}
/* read named parameters */
while( type(t) == CLOSURE && enclosing(actual(t)) == xsym &&
type(actual(t)) == NPAR )
{ new_par = t;
NextToken(t, res);
if( type(t) != LBR )
{ if( type(t) == RBR )
{ if( type(token) != LBR )
Error(5, 20, "unmatched %s in macro", WARN, &fpos(t), KW_RBR);
return;
}
Error(5, 21, "%s must follow named parameter %s",
WARN, &fpos(new_par), KW_LBR, SymName(actual(new_par)));
break;
}
/* add import list of the named parameter to current scope */
scope_count = 0;
imps = imports(actual(new_par));
if( imps != nilobj )
{ for( link = Down(imps); link != imps; link = NextDown(link) )
{ Child(y, link);
PushScope(actual(y), FALSE, TRUE);
scope_count++;
}
}
/* read the body of the named parameter */
PushScope(actual(new_par), FALSE, FALSE);
ReadTokenList(t, res);
PopScope();
/* pop the scopes pushed for the import list */
for( i = 0; i < scope_count; i++ )
PopScope();
/* get next token, possibly another named parameter */
PushScope(xsym, TRUE, FALSE);
NextToken(t, res);
PopScope();
}
/* read body parameter, if any */
if( has_body(xsym) )
{
if( type(t) == LBR || type(t) == BEGIN )
{ PushScope(xsym, FALSE, TRUE);
PushScope(ChildSym(xsym, RPAR), FALSE, FALSE);
if( type(t) == BEGIN ) actual(t) = xsym;
ReadTokenList(t, res);
PopScope();
PopScope();
NextToken(t, res);
}
else if( type(t) != RBR && type(t) != END )
Error(5, 22, "right parameter of %s must begin with %s",
WARN, &fpos(t), SymName(xsym), KW_LBR);
}
break;
default:
Error(5, 23, "ReadTokenList: %s", INTERN, &fpos(t), Image(type(t)));
break;
}
} /* end ReadTokenList */
void ReadDefinitions(OBJECT *token, OBJECT encl, unsigned char res_type)
{ OBJECT t, res, res_target, export_list, import_list, link, y, z;
OBJECT curr_encl; BOOLEAN compulsory_par, has_import_encl;
t = *token;
while( res_type==LOCAL || is_string(t, KW_NAMED) || is_string(t, KW_IMPORT) )
{
curr_encl = encl;
if( is_string(t, KW_LANGDEF) )
{ ReadLangDef(encl);
t = LexGetToken();
continue; /* next definition */
}
else if( type(t) == PREPEND || type(t) == SYS_PREPEND )
{ ReadPrependDef(type(t), encl);
Dispose(t);
t = LexGetToken();
continue; /* next definition */
}
else if( type(t) == INCG_REPEATED || type(t) == SINCG_REPEATED )
{ ReadIncGRepeatedDef(type(t), encl);
Dispose(t);
t = LexGetToken();
continue; /* next definition */
}
else if( type(t) == DATABASE || type(t) == SYS_DATABASE )
{ ReadDatabaseDef(type(t), encl);
Dispose(t);
t = LexGetToken();
continue; /* next definition */
}
if( !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) &&
!is_string(t, KW_NAMED) && !is_string(t, KW_IMPORT) &&
!is_string(t, KW_EXTEND) && !is_string(t, KW_EXPORT) )
break;
/* get import or extend list and change scope appropriately */
BodyParNotAllowed();
New(import_list, ACAT);
has_import_encl = FALSE;
if( is_string(t, KW_IMPORT) )
{ Dispose(t);
t = LexGetToken();
while( type(t) == CLOSURE ||
(type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
&& !is_string(t, KW_MACRO) && !is_string(t, KW_NAMED)) )
{ if( type(t) == CLOSURE )
{ if( type(actual(t)) == LOCAL )
{
/* *** letting this through now
if( res_type == NPAR && has_par(actual(t)) )
{
Error(5, 46, "named parameter import %s has parameters",
WARN, &fpos(t), SymName(actual(t)));
}
else
{
*** */
PushScope(actual(t), FALSE, TRUE);
if( actual(t) == encl ) has_import_encl = TRUE;
Link(import_list, t);
/* ***
}
*** */
}
else
{ Error(5, 26, "import name expected here", WARN, &fpos(t));
Dispose(t);
}
}
else
{ Error(5, 27, "import %s not in scope", WARN, &fpos(t), string(t));
Dispose(t);
}
t = LexGetToken();
}
}
else if( is_string(t, KW_EXTEND) )
{ Dispose(t);
t = LexGetToken();
while( type(t) == CLOSURE ||
(type(t)==WORD && !is_string(t,KW_EXPORT) && !is_string(t,KW_DEF)
&& !is_string(t, KW_MACRO)) )
{ if( type(t) == CLOSURE )
{ if( imports(actual(t)) != nilobj )
{ Error(5, 48, "%s has %s clause, so cannot be extended",
WARN, &fpos(t), SymName(actual(t)), KW_IMPORT);
}
else if( type(actual(t)) == LOCAL )
{ PushScope(actual(t), FALSE, FALSE);
curr_encl = actual(t);
debug1(DRD, D, " curr_encl = %s", SymName(curr_encl));
Link(import_list, t);
}
else
{ Error(5, 28, "%s symbol name expected here",
WARN, &fpos(t), KW_EXTEND);
Dispose(t);
}
}
else
{ Error(5, 29, "extend symbol %s not in scope", WARN,&fpos(t),string(t));
Dispose(t);
}
t = LexGetToken();
}
}
/* get export list and store for setting visible flags below */
New(export_list, ACAT);
if( is_string(t, KW_EXPORT) )
{ Dispose(t);
SuppressScope();
t = LexGetToken();
while( is_word(type(t)) && !is_string(t, KW_DEF) && !is_string(t, KW_IMPORT)
&& !is_string(t, KW_MACRO) && !is_string(t, KW_EXTEND) )
{ Link(export_list, t);
t = LexGetToken();
}
UnSuppressScope();
}
if( res_type == LOCAL && !is_string(t, KW_DEF) && !is_string(t, KW_MACRO) )
{ Error(5, 30, "keyword %s or %s expected here", WARN, &fpos(t),
KW_DEF, KW_MACRO);
break;
}
if( res_type == NPAR && !is_string(t, KW_NAMED) )
{ Error(5, 31, "keyword %s expected here", WARN, &fpos(t), KW_NAMED);
break;
}
if( is_string(t, KW_MACRO) )
{ if( Down(export_list) != export_list )
Error(5, 32, "ignoring export list of macro", WARN, &fpos(t));
res = ReadMacro(&t, curr_encl, encl);
}
else
{
SuppressScope(); Dispose(t); t = LexGetToken();
/* check for compulsory keyword */
if( res_type == NPAR && is_string(t, KW_COMPULSORY) )
{ compulsory_par = TRUE;
Dispose(t); t = LexGetToken();
}
else compulsory_par = FALSE;
/* find name of symbol and insert it */
if( !is_word(type(t)) )
{ Error(5, 33, "symbol name expected here", WARN, &fpos(t));
debug1(ANY, D, "offending type is %s", Image(type(t)));
UnSuppressScope();
*token = t;
return;
}
res = InsertSym(string(t), res_type, &fpos(t), DEFAULT_PREC,
FALSE, FALSE, 0, curr_encl, nilobj);
if( curr_encl != encl ) visible(res) = TRUE;
if( has_import_encl )
{
imports_encl(res) = TRUE;
debug1(DCE, D, " setting import_encl(%s) to TRUE", SymName(res));
}
if( compulsory_par )
{ has_compulsory(encl)++;
is_compulsory(res) = TRUE;
}
Dispose(t); t = LexGetToken();
/* find alternative names for this symbol */
while( is_word(type(t)) && !is_string(t, KW_NAMED) &&
!is_string(t, KW_IMPORT) &&
!is_string(t, KW_FORCE) && !is_string(t, KW_INTO) &&
!is_string(t, KW_HORIZ) && !is_string(t, KW_PRECEDENCE) &&
!is_string(t, KW_ASSOC) && !is_string(t, KW_LEFT) &&
!is_string(t, KW_RIGHT) && !is_string(t, KW_BODY) &&
!is_string(t, KW_LBR) && !is_string(t, KW_BEGIN) )
{
InsertAlternativeName(string(t), res, &fpos(t));
Dispose(t); t = LexGetToken();
}
/* find force, if any */
if( is_string(t, KW_FORCE) )
{ force_target(res) = TRUE;
Dispose(t); t = LexGetToken();
if( !is_string(t, KW_INTO) && !is_string(t, KW_HORIZ) )
Error(5, 34, "%s expected here", WARN, &fpos(t), KW_INTO);
}
/* find horizontally, if any */
if( is_string(t, KW_HORIZ) )
{ horiz_galley(res) = COLM;
Dispose(t); t = LexGetToken();
/* *** want to allow KW_HORIZ with @Target form now
if( !is_string(t, KW_INTO) )
Error(5, 35, "%s expected here", WARN, &fpos(t), KW_INTO);
*** */
}
/* find into clause, if any */
res_target = nilobj;
if( is_string(t, KW_INTO) )
{ UnSuppressScope();
Dispose(t); t = LexGetToken();
if( type(t) != LBR )
{ Error(5, 36, "%s expected here", WARN, &fpos(t), KW_LBR);
debug1(ANY, D, "offending type is %s", Image(type(t)));
UnSuppressScope();
*token = t;
return;
}
res_target = Parse(&t, curr_encl, FALSE, FALSE);
SuppressScope();
if( t == nilobj ) t = LexGetToken();
}
/* find precedence clause, if any */
if( is_string(t, KW_PRECEDENCE) )
{ int prec = 0;
UnSuppressScope();
Dispose(t);
t = LexGetToken();
while( type(t) == WORD && decimaldigit(string(t)[0]) )
{
prec = prec * 10 + digitchartonum(string(t)[0]);
Dispose(t); t = LexGetToken();
}
SuppressScope();
if( prec < MIN_PREC )
{ Error(5, 37, "precedence is too low (%d substituted)",
WARN, &fpos(t), MIN_PREC);
prec = MIN_PREC;
}
else if( prec > MAX_PREC )
{ Error(5, 38, "precedence is too high (%d substituted)",
WARN, &fpos(t), MAX_PREC);
prec = MAX_PREC;
}
precedence(res) = prec;
}
/* find associativity clause, if any */
if( is_string(t, KW_ASSOC) )
{
UnSuppressScope();
Dispose(t); t = LexGetToken();
if( is_string(t, KW_LEFT) ) right_assoc(res) = FALSE;
else if( !is_string(t, KW_RIGHT) )
Error(5, 39, "associativity altered to %s", WARN, &fpos(t), KW_RIGHT);
SuppressScope();
Dispose(t); t = LexGetToken();
}
/* find left parameter, if any */
if( is_string(t, KW_LEFT) )
{ Dispose(t); t = LexGetToken();
if( type(t) != WORD )
{ Error(5, 40, "cannot find %s parameter name", WARN, &fpos(t), KW_LEFT);
debug1(ANY, D, "offending type is %s", Image(type(t)));
UnSuppressScope();
*token = t;
return;
}
InsertSym(string(t), LPAR, &fpos(t), DEFAULT_PREC,
FALSE, FALSE, 0, res, nilobj);
Dispose(t); t = LexGetToken();
}
/* find named parameters, if any */
UnSuppressScope();
ReadDefinitions(&t, res, NPAR);
/* find right or body parameter, if any */
if( is_string(t, KW_RIGHT) || is_string(t, KW_BODY) )
{ has_body(res) = is_string(t, KW_BODY);
SuppressScope();
Dispose(t); t = LexGetToken();
if( type(t) != WORD )
{ Error(5, 41, "cannot find %s parameter name", WARN,&fpos(t),KW_RIGHT);
debug1(ANY, D, "offending type is %s", Image(type(t)));
UnSuppressScope();
*token = t;
return;
}
InsertSym(string(t), RPAR, &fpos(t), DEFAULT_PREC,
FALSE, FALSE, 0, res, nilobj);
UnSuppressScope();
Dispose(t); t = LexGetToken();
}
/* read local definitions and body */
if( res_target != nilobj )
InsertSym(KW_TARGET, LOCAL, &fpos(res_target), DEFAULT_PREC,
FALSE, FALSE, 0, res, res_target);
if( type(t) == WORD && StringEqual(string(t), KW_LBR) )
{ z = NewToken(LBR, &fpos(t), 0, 0, LBR_PREC, StartSym);
Dispose(t);
t = z;
}
else if( type(t) == WORD && StringEqual(string(t), KW_BEGIN) )
{ z = NewToken(BEGIN, &fpos(t), 0, 0, BEGIN_PREC, StartSym);
Dispose(t);
t = z;
}
else if( type(t) != LBR && type(t) != BEGIN )
Error(5, 42, "opening left brace or @Begin of %s expected",
FATAL, &fpos(t), SymName(res));
if( type(t) == BEGIN ) actual(t) = res;
PushScope(res, FALSE, FALSE);
BodyParAllowed();
sym_body(res) = Parse(&t, res, TRUE, FALSE);
/* set visible flag of the exported symbols */
for( link=Down(export_list); link != export_list; link=NextDown(link) )
{ Child(y, link);
z = SearchSym(string(y), StringLength(string(y)));
if( z == nilobj || enclosing(z) != res )
Error(5, 43, "exported symbol %s is not defined in %s",
WARN, &fpos(y), string(y), SymName(res));
else if( has_body(res) && type(z) == RPAR )
Error(5, 44, "body parameter %s may not be exported",
WARN, &fpos(y), string(y));
else if( visible(z) )
Error(5, 45, "symbol %s exported twice", WARN, &fpos(y), string(y));
else visible(z) = TRUE;
}
DisposeObject(export_list);
/* pop scope of res */
PopScope();
}
/* pop import scopes and store imports in sym tab */
for( link=Down(import_list); link != import_list; link=NextDown(link) )
{
PopScope();
}
if( Down(import_list) == import_list || curr_encl != encl )
{ DisposeObject(import_list);
import_list = nilobj;
}
else
{
imports(res) = import_list;
}
BodyParAllowed();
if( t == nilobj ) t = LexGetToken();
} /* end while */
*token = t;
return;
} /* end ReadDefinitions */
OBJECT InsertSym(FULL_CHAR *str, unsigned char xtype, FILE_POS *xfpos,
unsigned char xprecedence, BOOLEAN xindefinite, BOOLEAN xrecursive,
unsigned xpredefined, OBJECT xenclosing, OBJECT xbody)
{ register int sum, rlen;
register unsigned char *x;
OBJECT p, q, s, tmp, link, entry, plink; int len;
debug3(DST, DD, "InsertSym( %s, %s, in %s )",
Image(xtype), str, SymName(xenclosing));
if( !LexLegalName(str) )
Error(29, 3, "invalid symbol name %s", WARN, xfpos, str);
New(s, xtype);
FposCopy(fpos(s), *xfpos);
has_body(s) = FALSE;
filter(s) = nilobj;
use_invocation(s) = nilobj;
imports(s) = nilobj;
imports_encl(s) = FALSE;
right_assoc(s) = TRUE;
precedence(s) = xprecedence;
indefinite(s) = xindefinite;
recursive(s) = xrecursive;
predefined(s) = xpredefined;
enclosing(s) = xenclosing;
sym_body(s) = xbody;
base_uses(s) = nilobj;
uses(s) = nilobj;
marker(s) = nilobj;
cross_sym(s) = nilobj;
is_extern_target(s) = FALSE;
uses_extern_target(s)= FALSE;
visible(s) = FALSE;
uses_galley(s) = FALSE;
horiz_galley(s) = ROWM;
has_compulsory(s) = 0;
is_compulsory(s) = FALSE;
uses_count(s) = 0;
dirty(s) = FALSE;
if( enclosing(s) != nilobj && type(enclosing(s)) == NPAR )
dirty(s) = dirty(enclosing(s)) = TRUE;
has_par(s) = FALSE;
has_lpar(s) = FALSE;
has_rpar(s) = FALSE;
if( is_par(type(s)) ) has_par(enclosing(s)) = TRUE;
if( type(s) == LPAR ) has_lpar(enclosing(s)) = TRUE;
if( type(s) == RPAR ) has_rpar(enclosing(s)) = TRUE;
/* assign a code letter between a and z to any NPAR symbol */
if( type(s) == NPAR )
{ if( LastDown(enclosing(s)) != enclosing(s) )
{ Child(tmp, LastDown(enclosing(s)));
if( type(tmp) == NPAR )
{ if( npar_code(tmp) == 'z' || npar_code(tmp) == ' ' )
npar_code(s) = ' ';
else
npar_code(s) = npar_code(tmp)+1;
}
else
npar_code(s) = 'a';
}
else npar_code(s) = 'a';
}
has_target(s) = FALSE;
force_target(s) = FALSE;
if( !StringEqual(str, KW_TARGET) ) is_target(s) = FALSE;
else
{ is_target(s) = has_target(enclosing(s)) = TRUE;
/* if @Target is found after @Key, take note of external target */
if( has_key(enclosing(s)) && xbody != nilobj && is_cross(type(xbody)) )
{ if( LastDown(xbody) != Down(xbody) )
{ OBJECT sym;
Child(sym, Down(xbody));
if( type(sym) == CLOSURE )
{ is_extern_target(actual(sym)) = TRUE;
uses_extern_target(actual(sym)) = TRUE;
}
}
}
}
has_tag(s) = is_tag(s) = FALSE;
has_key(s) = is_key(s) = FALSE;
has_optimize(s) = is_optimize(s) = FALSE;
has_merge(s) = is_merge(s) = FALSE;
has_enclose(s) = is_enclose(s) = FALSE;
if( enclosing(s) != nilobj && type(enclosing(s)) == LOCAL )
{
if( StringEqual(str, KW_TAG) )
is_tag(s) = has_tag(enclosing(s)) = dirty(enclosing(s)) = TRUE;
if( StringEqual(str, KW_OPTIMIZE) )
is_optimize(s) = has_optimize(enclosing(s)) = TRUE;
if( StringEqual(str, KW_KEY) )
{ is_key(s) = has_key(enclosing(s)) = dirty(enclosing(s)) = TRUE;
/* if @Key is found after @Target, take note of external target */
for( link=Down(enclosing(s)); link!=enclosing(s); link=NextDown(link) )
{ Child(p, link);
if( is_target(p) && sym_body(p)!=nilobj && is_cross(type(sym_body(p))) )
{ OBJECT sym;
Child(sym, Down(sym_body(p)));
if( type(sym) == CLOSURE )
{ is_extern_target(actual(sym)) = TRUE;
uses_extern_target(actual(sym)) = TRUE;
}
}
}
}
if( StringEqual(str, KW_MERGE) )
is_merge(s) = has_merge(enclosing(s)) = TRUE;
if( StringEqual(str, KW_ENCLOSE) )
is_enclose(s) = has_enclose(enclosing(s)) = TRUE;
}
if( StringEqual(str, KW_FILTER) )
{ if( type(s) != LOCAL || enclosing(s) == StartSym )
Error(29, 4, "%s must be a local definition", WARN, &fpos(s), str);
else if( !has_rpar(enclosing(s)) )
Error(29, 14, "%s must lie within a symbol with a right parameter",
WARN, &fpos(s), KW_FILTER);
else
{ filter(enclosing(s)) = s;
precedence(enclosing(s)) = FILTER_PREC;
}
}
if( type(s) == RPAR && has_body(enclosing(s)) &&
(is_tag(s) || is_key(s) || is_optimize(s)) )
Error(29, 5, "a body parameter may not be named %s", WARN, &fpos(s), str);
if( type(s) == RPAR && has_target(enclosing(s)) &&
(is_tag(s) || is_key(s) || is_optimize(s)) )
Error(29, 6, "the right parameter of a galley may not be called %s",
WARN, &fpos(s), str);
len = StringLength(str);
hash(str, len, sum);
ifdebug(DST, D, sym_spread[sum]++; sym_count++);
entry = (OBJECT) &symtab[sum];
for( plink = Down(entry); plink != entry; plink = NextDown(plink) )
{ Child(p, plink);
if( length(p) == len && StringEqual(str, string(p)) )
{ for( link = Down(p); link != p; link = NextDown(link) )
{ Child(q, link);
if( enclosing(s) == enclosing(q) )
{ Error(29, 7, "symbol %s previously defined at%s",
WARN, &fpos(s), str, EchoFilePos(&fpos(q)) );
if( AltErrorFormat )
{
Error(29, 13, "symbol %s previously defined here",
WARN, &fpos(q), str);
}
break;
}
}
goto wrapup;
}
}
/* need a new OBJECT as well as s */
NewWord(p, WORD, len, xfpos);
length(p) = len;
StringCopy(string(p), str);
Link(entry, p);
wrapup:
Link(p, s);
if( enclosing(s) != nilobj ) Link(enclosing(s), s);
debug2(DST, DD, "InsertSym Link(%s, %s) and returning.",
SymName(enclosing(s)), SymName(s));
return s;
} /* end InsertSym */
OBJECT ClosureExpand(OBJECT x, OBJECT env, BOOLEAN crs_wanted,
OBJECT *crs, OBJECT *res_env)
{ OBJECT link, y, res, prnt_env, par, prnt;
debug3(DCE, D, "[ ClosureExpand( %s, %s, %s, crs, res_env )",
EchoObject(x), EchoObject(env), bool(crs_wanted));
assert( type(x) == CLOSURE, "ClosureExpand given non-CLOSURE!");
assert( predefined(actual(x)) == FALSE, "ClosureExpand given predefined!" );
/* add tag to x if needed but not provided; add cross-reference to crs */
if( has_tag(actual(x)) ) CrossAddTag(x);
if( crs_wanted && has_tag(actual(x)) )
{ OBJECT tmp = CopyObject(x, no_fpos); AttachEnv(env, tmp);
y = CrossMake(actual(x), tmp, CROSS_TARG);
New(tmp, CROSS_TARG); actual(tmp) = y; Link(tmp, y);
if( *crs == nilobj ) New(*crs, CR_LIST); Link(*crs, tmp);
}
/* case x is a parameter */
res = *res_env = nilobj;
if( is_par(type(actual(x))) )
{ prnt = SearchEnv(env, enclosing(actual(x)));
if( prnt != nilobj )
{
prnt_env = GetEnv(prnt);
for( link = Down(prnt); link != prnt; link = NextDown(link) )
{ Child(par, link);
if( type(par) == PAR && actual(par) == actual(x) )
{ assert( Down(par) != par, "ExpandCLosure: Down(par)!");
Child(res, Down(par));
if( dirty(enclosing(actual(par))) || is_enclose(actual(par)) )
{ debug2(DCE, DD, "copy %s %s", SymName(actual(par)), EchoObject(res));
res = CopyObject(res, no_fpos);
}
else
{
debug2(DCE, DD, "link %s %s",
FullSymName(actual(par), AsciiToFull(".")), EchoObject(res));
DeleteLink(Down(par));
y = MakeWord(WORD, STR_NOCROSS, &fpos(res));
Link(par, y);
}
ReplaceNode(res, x);
if( type(actual(x)) == RPAR && has_body(enclosing(actual(x))) )
{ debug0(DCR, DDD, " calling SetEnv from ClosureExpand (a)");
*res_env = SetEnv(prnt, nilobj); DisposeObject(x);
}
else if( type(actual(x)) == NPAR && imports_encl(actual(x)) )
{ debug0(DCR, DDD, " calling SetEnv from ClosureExpand (x)");
AttachEnv(env, x);
*res_env = SetEnv(x, nilobj);
}
else
{ AttachEnv(env, x);
debug0(DCR, DDD, " calling SetEnv from ClosureExpand (b)");
*res_env = SetEnv(x, prnt_env);
}
break;
}
}
}
else
{
/* fail only if there is no default value available */
if( sym_body(actual(x)) == nilobj )
{
debug3(DCE, D, "failing ClosureExpand( %s, crs, %s, %s, res_env )",
EchoObject(x), bool(crs_wanted), EchoObject(env));
Error(9, 2, "no value for parameter %s of symbol %s:", WARN, &fpos(x),
SymName(actual(x)), SymName(enclosing(actual(x))));
Error(9, 1, "symbol with import list misused", FATAL, &fpos(x));
}
}
}
/* case x is a user-defined symbol or default parameter */
if( res == nilobj )
{ if( sym_body(actual(x)) == nilobj )
res = MakeWord(WORD, STR_NOCROSS, &fpos(x));
else
res = CopyObject(sym_body(actual(x)), &fpos(x));
ReplaceNode(res, x); AttachEnv(env, x);
debug0(DCR, DDD, " calling SetEnv from ClosureExpand (c)");
*res_env = SetEnv(x, nilobj);
}
assert( *res_env!=nilobj && type(*res_env)==ENV, "ClosureExpand: *res_env!");
debug0(DCE, D, "] ClosureExpand returning, res =");
ifdebug(DCE, D, DebugObject(res));
debug1(DCE, D, " environment = %s", EchoObject(*res_env));
return res;
} /* end ClosureExpand */