/*@z05.c:Read Definitions:ReadFontDef()@**************************************/
/* */
/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.20) */
/* COPYRIGHT (C) 1991, 2000 Jeffrey H. Kingston */
/* */
/* Jeffrey H. Kingston (jeff@cs.usyd.edu.au) */
/* Basser Department of Computer Science */
/* The University of Sydney 2006 */
/* AUSTRALIA */
/* */
/* This program is free software; you can redistribute it and/or modify */
/* it under the terms of the GNU General Public License as published by */
/* the Free Software Foundation; either Version 2, or (at your option) */
/* any later version. */
/* */
/* This program is distributed in the hope that it will be useful, */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
/* GNU General Public License for more details. */
/* */
/* You should have received a copy of the GNU General Public License */
/* along with this program; if not, write to the Free Software */
/* Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA */
/* */
/* FILE: z05.c */
/* MODULE: Read Definitions */
/* EXTERNS: ReadPrependDef(), ReadDatabaseDef(), ReadDefinitions() */
/* */
/*****************************************************************************/
#include "externs.h"
/*****************************************************************************/
/* */
/* is_string(t, str) */
/* */
/* If t is a token denoting unquoted word str, return TRUE. */
/* */
/*****************************************************************************/
#define is_string(t, str) (type(t) == WORD && StringEqual(string(t), str) )
/*****************************************************************************/
/* */
/* static ReadFontDef(encl) */
/* */
/* Read one font definition and pass it on to the font module. The */
/* syntax is fontdef <family> <face> { <object> }. */
/* */
/*****************************************************************************/
static void ReadFontDef(OBJECT encl)
{ OBJECT t, family, face, inside;
SuppressScope();
/* get family name, allow for multiple tokens */
family = LexGetToken();
if( !is_word(type(family)) )
Error(5, 1, "expected font family name here", WARN, &fpos(family));
face = LexGetToken();
while( is_word(type(face)) && hspace(face) + vspace(face) == 0 )
{
family = MakeWordTwo(WORD, string(family), string(face), &fpos(family));
face = LexGetToken();
}
/* get face name, allow for multiple tokens */
if( !is_word(type(face)) )
Error(5, 2, "expected font face name here", WARN, &fpos(face));
UnSuppressScope();
t = LexGetToken();
while( is_word(type(t)) && hspace(t) + vspace(t) == 0 )
{
face = MakeWordTwo(WORD, string(face), string(t), &fpos(face));
t = LexGetToken();
}
if( type(t) != LBR )
{ Error(5, 3, "expected opening %s of fontdef here", WARN, &fpos(t), KW_LBR);
Dispose(t);
return;
}
inside = Parse(&t, encl, FALSE, FALSE);
inside = ReplaceWithTidy(inside, FALSE);
FontDefine(family, face, inside);
return;
} /* end ReadFontDef */
/*****************************************************************************/
/* */
/* static ReadLangDef(encl) */
/* */
/* Read one language definition and pass it on to the language module. The */
/* syntax is langdef <name> ... <name> { <object> } */
/* */
/*****************************************************************************/
static void ReadLangDef(OBJECT encl)
{ OBJECT t, names, inside;
New(names, ACAT);
t = LexGetToken();
while( is_word(type(t)) )
{ Link(names, t);
t = LexGetToken();
}
if( type(t) != LBR )
{ Error(5, 4, "expected opening %s of langdef here", WARN, &fpos(t), KW_LBR);
Dispose(t);
return;
}
inside = Parse(&t, encl, FALSE, FALSE);
inside = ReplaceWithTidy(inside, FALSE);
LanguageDefine(names, inside);
return;
} /* end ReadLangDef */
/*@::ReadPrependDef(), ReadDatabaseDef()@*************************************/
/* */
/* ReadPrependDef(typ, encl) */
/* */
/* Read @Prepend { <filename> } and record its presence. */
/* */
/*****************************************************************************/
void ReadPrependDef(unsigned typ, OBJECT encl)
{ OBJECT t, fname;
t = LexGetToken();
if( type(t) != LBR )
{ Error(5, 5, "left brace expected here in %s declaration",
WARN, &fpos(t), KW_PREPEND);
Dispose(t);
return;
}
fname = Parse(&t, encl, FALSE, FALSE);
fname = ReplaceWithTidy(fname, FALSE);
if( !is_word(type(fname)) )
{ Error(5, 6, "name of %s file expected here", WARN, &fpos(fname),KW_PREPEND);
DisposeObject(fname);
return;
}
debug0(DFS, D, " calling DefineFile from ReadPrependDef");
DefineFile(string(fname), STR_EMPTY, &fpos(fname), PREPEND_FILE,
typ == PREPEND ? INCLUDE_PATH : SYSINCLUDE_PATH);
} /* end ReadPrependDef */
/*****************************************************************************/
/* */
/* ReadDatabaseDef(typ, encl) */
/* */
/* Read @Database <symname> ... <symname> { <filename> } and record it. */
/* */
/*****************************************************************************/
void ReadDatabaseDef(unsigned typ, OBJECT encl)
{ OBJECT symbs, t, fname;
New(symbs, ACAT);
t = LexGetToken();
while( type(t)==CLOSURE || (type(t)==WORD && string(t)[0]==CH_SYMSTART) )
{ if( type(t) == CLOSURE )
{ Link(symbs, t);
}
else
{ Error(5, 7, "unknown or misspelt symbol %s", WARN, &fpos(t), string(t));
Dispose(t);
}
t = LexGetToken();
}
if( type(t) != LBR )
{ Error(5, 8, "symbol name or %s expected here (%s declaration)",
WARN, &fpos(t), KW_LBR, KW_DATABASE);
Dispose(t);
return;
}
if( Down(symbs) == symbs )
{ Error(5, 9, "symbol names missing in %s declaration",
WARN, &fpos(t), KW_DATABASE);
}
fname = Parse(&t, encl, FALSE, FALSE);
fname = ReplaceWithTidy(fname, FALSE);
if( !is_word(type(fname)) )
{ Error(5, 10, "name of %s file expected here", WARN, &fpos(fname),
KW_DATABASE);
DisposeObject(fname);
return;
}
if( StringEndsWith(string(fname), DATA_SUFFIX) )
{ Error(5, 47, "%s suffix should be omitted in %s clause", WARN,
&fpos(fname), DATA_SUFFIX, KW_DATABASE);
DisposeObject(fname);
return;
}
if( Down(symbs) != symbs )
(void) DbLoad(fname, typ == DATABASE ? DATABASE_PATH : SYSDATABASE_PATH,
TRUE, symbs, InMemoryDbIndexes);
} /* end ReadDatabaseDef */
/*@::ReadTokenList()@*********************************************************/
/* */
/* static ReadTokenList(token, res) */
/* */
/* Read a list of tokens from input and append them to sym_body(res). */
/* The list is assumed to begin immediately after token, which is either */
/* an LBR or a @Begin, and input is to be read up to and including the */
/* matching RBR or @End @Sym. */
/* */
/*****************************************************************************/
#define NextToken(t, res) \
t = LexGetToken(); sym_body(res) = Append(sym_body(res), t, PARENT);
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 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 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 PLUS:
case MINUS:
case TAGGED:
case INCGRAPHIC:
case SINCGRAPHIC:
case PLAIN_GRAPHIC:
case GRAPHIC:
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 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 */
/*@::ReadMacro()@*************************************************************/
/* */
/* static OBJECT ReadMacro(token, encl) */
/* */
/* Read a macro from input and insert into symbol table. */
/* Token *token contains the "macro" keyword. Input is read up to and */
/* including the closing right brace, and nilobj returned in *token if OK. */
/* The proper scope for reading the macro body is open at entry and exit. */
/* ReadMacro returns the new symbol table entry if successful, else nilobj. */
/* */
/*****************************************************************************/
static OBJECT ReadMacro(OBJECT *token, OBJECT curr_encl, OBJECT encl)
{ OBJECT t, res;
/* find macro name and insert into symbol table */
SuppressScope();
Dispose(*token); t = LexGetToken();
if( !is_word(type(t)) )
{ Error(5, 24, "%s ignored (name is missing)", WARN, &fpos(t), KW_MACRO);
debug1(ANY, D, "offending type is %s", Image(type(t)));
UnSuppressScope();
*token = t;
return nilobj;
}
res = InsertSym(string(t), MACRO, &fpos(t), 0, FALSE,TRUE,0,curr_encl,nilobj);
if( curr_encl != encl ) visible(res) = TRUE;
UnSuppressScope();
/* find alternative names for this symbol */
Dispose(t); t = LexGetToken();
while( is_word(type(t)) )
{
InsertAlternativeName(string(t), res, &fpos(t));
Dispose(t); t = LexGetToken();
}
/* find opening left brace */
if( type(t) != LBR )
{ Error(5, 25, "%s ignored (opening %s is missing)",
WARN, &fpos(t), KW_MACRO, KW_LBR);
*token = t;
return nilobj;
}
/* read macro body */
ReadTokenList(t, res);
Dispose(t);
/* clean up (kill final RBR, dispose macro name) and exit */
t = pred(sym_body(res), PARENT);
sym_body(res) = Delete(t, PARENT);
Dispose(t);
recursive(res) = FALSE;
*token = nilobj;
return res;
} /* end ReadMacro */
/*@::ReadDefinitions()@*******************************************************/
/* */
/* ReadDefinitions(token, encl, res_type) */
/* */
/* Read a sequence of definitions and insert them into the symbol table. */
/* Either a sequence of local definitions (res_type == LOCAL) or named */
/* parameters (res_type == NPAR) is expected; *token is the first def etc. */
/* A scope appropriate for reading the bodies of the definitions is open. */
/* The parent definition is encl. */
/* */
/*****************************************************************************/
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_FONTDEF) )
{ ReadFontDef(encl);
t = LexGetToken();
continue; /* next definition */
}
else 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) == 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;
Dispose(t);
t = LexGetToken();
while( type(t) == WORD && decimaldigit(string(t)[0]) )
{
prec = prec * 10 + digitchartonum(string(t)[0]);
Dispose(t); t = LexGetToken();
}
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) )
{ 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);
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 */
