diff options
Diffstat (limited to 'z05.c')
| -rw-r--r-- | z05.c | 877 |
1 files changed, 877 insertions, 0 deletions
@@ -0,0 +1,877 @@ +/*@z05.c:Read Definitions:ReadFontDef()@**************************************/ +/* */ +/* THE LOUT DOCUMENT FORMATTING SYSTEM (VERSION 3.17) */ +/* COPYRIGHT (C) 1991, 1999 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 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 LANGUAGE: + case CURR_LANG: + case CURR_FAMILY: + case CURR_FACE: + 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 */ |