in MultiSource/Benchmarks/MiBench/consumer-typeset/z06.c [788:1553]
OBJECT Parse(OBJECT *token, OBJECT encl,
BOOLEAN defs_allowed, BOOLEAN transfer_allowed)
{ OBJECT t, x, tmp, xsym, env, y, link, res, imps, xlink;
int i, offset, lnum, initial_ttop = ttop;
int obj_prev, scope_count, compulsory_count; BOOLEAN revealed;
debugcond4(DOP, DD, debug_now, "[ Parse(%s, %s, %s, %s)", EchoToken(*token),
SymName(encl), bool(defs_allowed), bool(transfer_allowed));
assert( type(*token) == LBR || type(*token) == BEGIN, "Parse: *token!" );
obj_prev = PREV_OP;
Shift(*token, precedence(*token), 0, FALSE, TRUE);
t = LexGetToken();
if( defs_allowed )
{ ReadDefinitions(&t, encl, LOCAL);
/* if error in definitions, stop now */
if( ErrorSeen() )
Error(6, 14, "exiting now", FATAL, &fpos(t));
if( encl == StartSym )
{
/* read @Use, @Database, and @Prepend commands and defs and construct env */
New(env, ENV);
for(;;)
{
if( type(t) == WORD && (
StringEqual(string(t), KW_DEF) ||
/* StringEqual(string(t), KW_FONTDEF) || */
StringEqual(string(t), KW_LANGDEF) ||
StringEqual(string(t), KW_MACRO) ||
StringEqual(string(t), KW_IMPORT) ||
StringEqual(string(t), KW_EXTEND) ||
StringEqual(string(t), KW_EXPORT) ) )
{
ReadDefinitions(&t, encl, LOCAL);
/* if error in definitions, stop now */
if( ErrorSeen() )
Error(6, 39, "exiting now", FATAL, &fpos(t));
}
else if( type(t) == USE )
{
OBJECT crs, res_env; STYLE style;
Dispose(t); t = LexGetToken();
if( type(t) != LBR )
Error(6, 15, "%s expected after %s", FATAL, &fpos(t),KW_LBR,KW_USE);
debug0(DOP, DD, " Parse() calling Parse for @Use clause");
y = Parse(&t, encl, FALSE, FALSE);
if( is_cross(type(y)) )
{ OBJECT z;
Child(z, Down(y));
if( type(z) == CLOSURE )
{ crs = nilobj;
y = CrossExpand(y, env, &style, &crs, &res_env);
if( crs != nilobj )
{ Error(6, 16, "%s or %s tag not allowed here",
FATAL, &fpos(y), KW_PRECEDING, KW_FOLLOWING);
}
HuntCommandOptions(y);
AttachEnv(res_env, y);
debug0(DCR, DDD, " calling SetEnv from Parse (a)");
env = SetEnv(y, env);
}
else Error(6, 17, "invalid parameter of %s", FATAL, &fpos(y), KW_USE);
}
else if( type(y) == CLOSURE )
{ if( use_invocation(actual(y)) != nilobj )
Error(6, 18, "symbol %s occurs in two %s clauses",
FATAL, &fpos(y), SymName(actual(y)), KW_USE);
use_invocation(actual(y)) = y;
HuntCommandOptions(y);
AttachEnv(env, y);
debug0(DCR, DDD, " calling SetEnv from Parse (b)");
env = SetEnv(y, nilobj);
}
else Error(6, 19, "invalid parameter of %s", FATAL, &fpos(y), KW_USE);
PushScope(actual(y), FALSE, TRUE);
t = LexGetToken();
}
else if( type(t) == PREPEND || type(t) == SYS_PREPEND )
{ ReadPrependDef(type(t), encl);
Dispose(t);
t = LexGetToken();
}
else if( type(t) == DATABASE || type(t) == SYS_DATABASE )
{ ReadDatabaseDef(type(t), encl);
Dispose(t);
t = LexGetToken();
}
else break;
}
/* transition point from defs to content; turn on debugging now */
#if DEBUG_ON
debug_now = TRUE;
#endif
debugcond4(DOP, DD, debug_now, "[ Parse (first) (%s, %s, %s, %s)",
EchoToken(*token), SymName(encl), bool(defs_allowed),
bool(transfer_allowed));
/* load cross-references from previous run, open new cross refs */
if( AllowCrossDb )
{
NewCrossDb = DbCreate(MakeWord(WORD, string(cross_name), no_fpos));
OldCrossDb = DbLoad(cross_name, SOURCE_PATH, FALSE, nilobj,
InMemoryDbIndexes);
}
else OldCrossDb = NewCrossDb = nilobj;
/* tidy up and possibly print symbol table */
FlattenUses();
ifdebug(DST, DD, DebugObject(StartSym));
TransferInit(env);
debug0(DMA, D, "at end of definitions:");
ifdebug(DMA, D, DebugMemory());
}
}
for(;;)
{
debugcond0(DOP, DD, debug_now, "");
ifdebugcond(DOP, DD, debug_now, DebugStacks(0, obj_prev));
debugcond0(DOP, DD, debug_now, "");
debugcond2(DOP, DD, debug_now, ">> %s (precedence %d)", EchoToken(t), precedence(t));
switch( type(t) )
{
case WORD:
if( string(t)[0] == CH_SYMSTART &&
(obj_prev != PREV_OBJ || vspace(t) + hspace(t) > 0) )
{
Error(6, 20, "symbol %s unknown or misspelt",
WARN, &fpos(t), string(t));
if( ++unknown_count > 25 )
{
Error(6, 21, "too many errors (%s lines missing or out of order?)",
FATAL, &fpos(t), KW_SYSINCLUDE);
}
}
ShiftObj(t, PREV_OBJ);
t = LexGetToken();
break;
case QWORD:
ShiftObj(t, PREV_OBJ);
t = LexGetToken();
break;
case VCAT:
case HCAT:
case ACAT:
/* clean up left context */
Shift(t, precedence(t), LEFT_ASSOC, TRUE, TRUE);
/* invoke transfer subroutines if appropriate */
/* *** if( type(t) == VCAT && !has_join(actual(t)) *** */
if( transfer_allowed && type(t) == VCAT && !has_join(actual(t))
&& type(tok_stack[ttop-2]) == GSTUB_EXT )
{
debug0(DGT, DD, " calling TransferComponent from Parse:");
ifdebug(DGT, DD, DebugStacks(0, obj_prev));
TransferComponent( PopObj() );
New(tmp, NULL_CLOS);
FposCopy( fpos(tmp), fpos(t) );
PushObj(tmp);
}
/* push GAP_OBJ token, to cope with 3 parameters */
New(x, GAP_OBJ);
mark(gap(x)) = has_mark(actual(t));
join(gap(x)) = has_join(actual(t));
hspace(x) = hspace(t);
vspace(x) = vspace(t);
precedence(x) = GAP_PREC;
FposCopy( fpos(x), fpos(t) );
Shift(x, GAP_PREC, LEFT_ASSOC, FALSE, TRUE);
/* if op is followed by space, insert {} */
t = LexGetToken();
if( hspace(t) + vspace(t) > 0 )
{ ShiftObj(MakeWord(WORD, STR_EMPTY, &fpos(x)), PREV_OBJ);
}
break;
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 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 CASE:
case YIELD:
case BACKEND:
case XCHAR:
case FONT:
case SPACE:
case YUNIT:
case ZUNIT:
case BREAK:
case UNDERLINE:
case COLOUR:
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 TAGGED:
case INCGRAPHIC:
case SINCGRAPHIC:
case PLAIN_GRAPHIC:
case GRAPHIC:
case LINK_SOURCE:
case LINK_DEST:
/* clean up left context of t (these ops are all right associative) */
Shift(t, precedence(t), RIGHT_ASSOC,
has_lpar(actual(t)), has_rpar(actual(t)));
t = LexGetToken();
break;
case VERBATIM:
case RAW_VERBATIM:
/* clean up left context of t */
x = t;
Shift(t, precedence(t), RIGHT_ASSOC,
has_lpar(actual(t)), has_rpar(actual(t)));
/* check for opening brace or begin following, and shift it onto the stacks */
t = LexGetToken();
if( type(t) != BEGIN && type(t) != LBR )
Error(6, 40, "right parameter of %s or %s must be enclosed in braces",
FATAL, &fpos(x), KW_VERBATIM, KW_RAWVERBATIM);
actual(t) = type(x) == VERBATIM ? VerbatimSym : RawVerbatimSym;
Shift(t, LBR_PREC, 0, FALSE, TRUE);
/* read right parameter and add it to the stacks, and reduce */
y = LexScanVerbatim( (FILE *) NULL, type(t) == BEGIN, &fpos(t),
type(x) == RAW_VERBATIM);
ShiftObj(y, PREV_OBJ);
/* carry on, hopefully to the corresponding right brace or @End @Verbatim */
t = LexGetToken();
break;
case PLUS:
case MINUS:
/* clean up left context of t (these ops are all left associative) */
Shift(t, precedence(t), LEFT_ASSOC,
has_lpar(actual(t)), has_rpar(actual(t)));
t = LexGetToken();
break;
case UNEXPECTED_EOF:
Error(6, 22, "unexpected end of input", FATAL, &fpos(t));
break;
case BEGIN:
if( actual(t) == nilobj )
{ Error(6, 23, "%s replaced by %s", WARN, &fpos(t), KW_BEGIN, KW_LBR);
type(t) = LBR;
}
/* NB NO BREAK! */
case LBR:
Shift(t, LBR_PREC, 0, FALSE, TRUE);
t = LexGetToken();
break;
case END:
if( actual(t) == nilobj ) /* haven't sought following symbol yet */
{ x = LexGetToken();
if( type(x) == CLOSURE )
{ actual(t) = actual(x);
Dispose(x);
x = nilobj;
}
else if( type(x) == VERBATIM )
{ actual(t) = VerbatimSym;
Dispose(x);
x = nilobj;
}
else if( type(x) == RAW_VERBATIM )
{ actual(t) = RawVerbatimSym;
Dispose(x);
x = nilobj;
}
else if( type(x) == WORD && string(x)[0] == CH_SYMSTART )
{ Error(6, 24, "unknown or misspelt symbol %s after %s deleted",
WARN, &fpos(x), string(x), KW_END);
actual(t) = nilobj;
Dispose(x);
x = nilobj;
}
else
{ Error(6, 25, "symbol expected after %s", WARN, &fpos(x), KW_END);
actual(t) = nilobj;
}
}
else x = nilobj;
Shift(t, precedence(t), 0, TRUE, FALSE);
t = (x != nilobj) ? x : LexGetToken();
break;
case RBR:
Shift(t, precedence(t), 0, TRUE, FALSE);
t = LexGetToken();
break;
case USE:
case NOT_REVEALED:
case PREPEND:
case SYS_PREPEND:
case DATABASE:
case SYS_DATABASE:
Error(6, 26, "%s symbol out of place",
FATAL, &fpos(t), SymName(actual(t)));
break;
case ENV:
/* only occurs in cross reference databases */
res = ParseEnvClosure(t, encl);
ShiftObj(res, PREV_OBJ);
t = LexGetToken();
break;
case ENVA:
/* only occurs in cross reference databases */
offset = LexNextTokenPos() -StringLength(KW_ENVA)-StringLength(KW_LBR)-1;
Dispose(t); t = LexGetToken();
tmp = Parse(&t, encl, FALSE, FALSE);
env = SetEnv(tmp, nilobj);
ShiftObj(env, PREV_OBJ);
t = LexGetToken();
EnvReadInsert(file_num(fpos(t)), offset, env);
break;
case ENVB:
/* only occurs in cross reference databases */
offset = LexNextTokenPos() -StringLength(KW_ENVB)-StringLength(KW_LBR)-1;
Dispose(t); t = LexGetToken();
env = Parse(&t, encl, FALSE, FALSE);
t = LexGetToken();
res = Parse(&t, encl, FALSE, FALSE);
env = SetEnv(res, env);
ShiftObj(env, PREV_OBJ);
t = LexGetToken();
EnvReadInsert(file_num(fpos(t)), offset, env);
break;
case ENVC:
/* only occurs in cross reference databases */
Dispose(t); t = LexGetToken();
New(res, ENV);
ShiftObj(res, PREV_OBJ);
break;
case ENVD:
/* only occurs in cross reference databases */
Dispose(t); t = LexGetToken();
if( type(t) != QWORD ||
sscanf((char *) string(t), "%d %d", &offset, &lnum) != 2 )
Error(6, 37, "error in cross reference database", FATAL, &fpos(t));
if( !EnvReadRetrieve(file_num(fpos(t)), offset, &env) )
{ LexPush(file_num(fpos(t)), offset, DATABASE_FILE, lnum, TRUE);
Dispose(t); t = LexGetToken();
env = Parse(&t, encl, FALSE, FALSE);
LexPop();
}
else
{ Dispose(t);
}
ShiftObj(env, PREV_OBJ);
t = LexGetToken();
break;
case CENV:
/* only occurs in cross reference databases */
Dispose(t); t = LexGetToken();
env = Parse(&t, encl, FALSE, FALSE);
scope_count = 0;
SetScope(env, &scope_count, FALSE);
t = LexGetToken();
res = Parse(&t, encl, FALSE, FALSE);
for( i = 0; i < scope_count; i++ ) PopScope();
AttachEnv(env, res);
ShiftObj(res, PREV_OBJ);
t = LexGetToken();
break;
case LUSE:
/* only occurs in cross-reference databases */
/* copy invocation from use_invocation(xsym), don't read it */
Dispose(t); t = LexGetToken();
if( type(t) != CLOSURE )
Error(6, 27, "symbol expected following %s", FATAL,&fpos(t),KW_LUSE);
xsym = actual(t);
if( use_invocation(xsym) == nilobj )
Error(6, 28, "%s clause(s) changed from previous run",
FATAL, &fpos(t), KW_USE);
x = CopyObject(use_invocation(xsym), no_fpos);
for( link = LastDown(x); link != x; link = PrevDown(link) )
{ Child(y, link);
if( type(y) == ENV )
{ DeleteLink(link);
break;
}
}
ShiftObj(x, PREV_OBJ);
t = LexGetToken();
break;
case LVIS:
/* only occurs in cross-reference databases */
SuppressVisible();
Dispose(t); t = LexGetToken();
UnSuppressVisible();
if( type(t) != CLOSURE )
Error(6, 29, "symbol expected following %s", FATAL,&fpos(t),KW_LVIS);
/* NB NO BREAK! */
case CLOSURE:
x = t; xsym = actual(x);
/* look ahead one token, which could be an NPAR */
/* or could be @NotRevealed */
PushScope(xsym, TRUE, FALSE);
t = LexGetToken();
if( type(t) == NOT_REVEALED )
{ Dispose(t);
t = LexGetToken();
revealed = FALSE;
}
else revealed = TRUE;
PopScope();
/* if x starts a cross-reference, make it a CLOSURE */
if( is_cross(type(t)) )
{ ShiftObj(x, PREV_OBJ);
break;
}
/* clean up left context of x */
Shift(x,precedence(x),right_assoc(xsym),has_lpar(xsym),has_rpar(xsym));
/* update uses relation if required */
if( encl != StartSym && encl != nilobj )
{ if( has_target(xsym) )
{ uses_galley(encl) = TRUE;
dirty(encl) = (dirty(encl) || dirty(xsym));
}
else if( revealed ) InsertUses(encl, xsym);
}
/* read named parameters */
compulsory_count = 0;
while( (type(t) == CLOSURE && enclosing(actual(t)) == xsym
&& type(actual(t)) == NPAR)
|| (type(t) == LBR && precedence(t) != LBR_PREC) )
{
OBJECT new_par;
/* check syntax and attach the named parameter to x */
if( type(t) == CLOSURE )
{
new_par = t;
t = LexGetToken();
if( type(t) != LBR )
{ Error(6, 30, "%s must follow named parameter %s",
WARN, &fpos(new_par), KW_LBR, SymName(actual(new_par)));
Dispose(new_par);
break;
}
}
else
{
/* compressed form of named parameter */
new_par = NewToken(CLOSURE, &fpos(t), vspace(t), hspace(t),
NO_PREC, ChildSymWithCode(x, precedence(t)));
precedence(t) = LBR_PREC;
}
/* 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);
tmp = Parse(&t, encl, FALSE, FALSE);
PopScope();
type(new_par) = PAR;
Link(new_par, tmp);
/* pop the scopes pushed for the import list */
for( i = 0; i < scope_count; i++ )
PopScope();
/* check that new_par has not already occurred, then link it to x */
for( link = Down(x); link != x; link = NextDown(link) )
{ Child(y, link);
assert( type(y) == PAR, "Parse: type(y) != PAR!" );
if( actual(new_par) == actual(y) )
{ Error(6, 31, "named parameter %s of %s appears twice", WARN,
&fpos(new_par), SymName(actual(new_par)), SymName(actual(x)));
DisposeObject(new_par);
new_par = nilobj;
break;
}
}
if( new_par != nilobj )
{
/* keep track of the number of compulsory named parameters */
if( is_compulsory(actual(new_par)) )
compulsory_count++;
Link(x, new_par);
}
/* get next token, possibly another NPAR */
PushScope(xsym, TRUE, FALSE); /* allow NPARs only */
if( t == nilobj ) t = LexGetToken();
PopScope();
} /* end while */
/* report absence of compulsory parameters */
debug4(DOP, D, "%s %s %d : %d", EchoFilePos(&fpos(x)),
SymName(xsym), compulsory_count, has_compulsory(xsym));
if( compulsory_count < has_compulsory(xsym) )
{
for( xlink = Down(xsym); xlink != xsym; xlink = NextDown(xlink) )
{ Child(tmp, xlink);
if( type(tmp) == NPAR && is_compulsory(tmp) )
{ for( link = Down(x); link != x; link = NextDown(link) )
{ Child(y, link);
if( type(y) == PAR && actual(y) == tmp )
break;
}
if( link == x )
{
Error(6, 38, "compulsory option %s missing from %s",
WARN, &fpos(x), SymName(tmp), SymName(xsym));
}
}
}
}
/* record symbol name in BEGIN following, if any */
if( type(t) == BEGIN )
{ if( !has_rpar(xsym) )
Error(6, 32, "%s out of place here (%s has no right parameter)",
WARN, &fpos(x), KW_BEGIN, SymName(xsym));
else actual(t) = xsym;
}
/* if x can be transferred, do so */
if( transfer_allowed && has_target(xsym) &&
!has_key(xsym) && filter(xsym) == nilobj )
{
if( !has_rpar(xsym) || uses_count(ChildSym(xsym, RPAR)) <= 1 )
{
debug1(DGT, D, "examining transfer of %s", SymName(xsym));
ifdebug(DGT, D, DebugStacks(initial_ttop, obj_prev));
i = has_rpar(xsym) ? ttop -1 : ttop;
while( is_cat_op(type(tok_stack[i])) ) i--;
if( (type(tok_stack[i])==LBR || type(tok_stack[i])==BEGIN)
&& type(tok_stack[i-1]) == GSTUB_EXT )
{
/* at this point it is likely that x is transferable */
if( has_rpar(xsym) )
{ New(tmp, CLOSURE);
actual(tmp) = InputSym;
FposCopy( fpos(tmp), fpos(t) );
ShiftObj(tmp, PREV_OBJ);
obj_prev = Reduce();
}
x = PopObj();
x = TransferBegin(x);
if( type(x) == CLOSURE ) /* failure: unReduce */
{ if( has_rpar(xsym) )
{ Child(tmp, LastDown(x));
assert(type(tmp)==PAR && type(actual(tmp))==RPAR,
"Parse: cannot undo rpar" );
DisposeChild(LastDown(x));
if( has_lpar(xsym) )
{ Child(tmp, Down(x));
assert(type(tmp)==PAR && type(actual(tmp))==LPAR,
"Parse: cannot undo lpar" );
Child(tmp, Down(tmp));
PushObj(tmp);
DeleteLink(Up(tmp));
DisposeChild(Down(x));
}
PushToken(x); obj_prev = PREV_OP;
}
else
{ PushObj(x);
obj_prev = PREV_OBJ;
}
}
else /* success */
{ obj_prev = PREV_OP;
Shift(x, NO_PREC, 0, FALSE, has_rpar(xsym));
}
}
}
} /* end if has_target */
if( filter(xsym) != nilobj )
{
if( type(t) == BEGIN || type(t) == LBR )
{
/* create filter object and copy parameter into temp file */
tmp = FilterCreate((BOOLEAN) (type(t) == BEGIN), xsym, &fpos(t));
/* push filter object onto stacks and keep going */
Shift(t, precedence(t), 0, FALSE, TRUE);
ShiftObj(tmp, PREV_OBJ);
t = LexGetToken();
}
else Error(6, 33, "right parameter of %s must be enclosed in braces",
FATAL, &fpos(x), SymName(xsym));
}
else if( has_body(xsym) )
{ if( type(t) == BEGIN || type(t) == LBR )
{ PushScope(xsym, FALSE, TRUE);
PushScope(ChildSym(xsym, RPAR), FALSE, FALSE);
PushObj( Parse(&t, encl, FALSE, TRUE) );
obj_prev = Reduce();
PopScope();
PopScope();
if( t == nilobj ) t = LexGetToken();
}
else
{ Error(6, 34, "body parameter of %s must be enclosed in braces",
WARN, &fpos(t), SymName(xsym));
}
}
break;
case OPEN:
x = t; xsym = nilobj;
Shift(t, precedence(t), RIGHT_ASSOC, TRUE, TRUE);
if( type(ObjTop) == CLOSURE ) xsym = actual(ObjTop);
else if( is_cross(type(ObjTop)) && Down(ObjTop) != ObjTop )
{ Child(tmp, Down(ObjTop));
if( type(tmp) == CLOSURE ) xsym = actual(tmp);
}
t = LexGetToken();
if( xsym == nilobj )
Error(6, 35, "invalid left parameter of %s", WARN, &fpos(x), KW_OPEN);
else if( type(t) != BEGIN && type(t) != LBR )
Error(6, 36, "right parameter of %s must be enclosed in braces",
WARN, &fpos(t), KW_OPEN);
else
{ PushScope(xsym, FALSE, TRUE);
tmp = Parse(&t, encl, FALSE, FALSE);
ShiftObj(tmp, PREV_RBR);
PopScope();
if( t == nilobj ) t = LexGetToken();
obj_prev = Reduce();
}
break;
default:
assert1(FALSE, "Parse:", Image(type(t)));
break;
} /* end switch */
} /* end for */
} /* end Parse */