diff options
Diffstat (limited to 'src/iconc/dbase.c')
| -rw-r--r-- | src/iconc/dbase.c | 196 |
1 files changed, 196 insertions, 0 deletions
diff --git a/src/iconc/dbase.c b/src/iconc/dbase.c new file mode 100644 index 0000000..fdd3e50 --- /dev/null +++ b/src/iconc/dbase.c @@ -0,0 +1,196 @@ +/* + * dbase.c - routines to access data base of implementation information + * produced by rtt. + */ +#include "../h/gsupport.h" +#include "../h/lexdef.h" +#include "ctrans.h" +#include "csym.h" +#include "ctree.h" +#include "ccode.h" +#include "cproto.h" +#include "cglobals.h" + +/* + * Prototypes. + */ +static int chck_spec (struct implement *ip); +static int acpt_op (struct implement *ip); + + +static struct optab *optr; /* pointer into operator table */ + +/* + * readdb - read data base produced by rtt. + */ +void readdb(db_name) +char *db_name; + { + char *op, *s; + int i; + struct implement *ip; + char buf[MaxPath]; /* file name construction buffer */ + struct fileparts *fp; + unsigned hashval; + + fp = fparse(db_name); + if (*fp->ext == '\0') + db_name = salloc(makename(buf, NULL, db_name, DBSuffix)); + else if (!smatch(fp->ext, DBSuffix)) + quitf("bad data base name: %s", db_name); + + if (!db_open(db_name, &s)) + db_err1(1, "cannot open data base"); + + if (largeints && (*s == 'N')) { + twarn("Warning, run-time system does not support large integers", NULL); + largeints = 0; + } + + /* + * Read information about functions. + */ + db_tbl("functions", bhash); + + /* + * Read information about operators. + */ + optr = optab; + + /* + * read past operators header. + */ + db_chstr("operators", "operators"); + + while ((op = db_string()) != NULL) { + if ((ip = db_impl('O')) == NULL) + db_err2(1, "no implementation information for operator", op); + ip->op = op; + if (acpt_op(ip)) { + db_code(ip); + hashval = IHasher(op); + ip->blink = ohash[hashval]; + ohash[hashval] = ip; + db_chstr("end", "end"); + } + else + db_dscrd(ip); + } + db_chstr("endsect", "endsect"); + + /* + * Read information about keywords. + */ + db_tbl("keywords", khash); + + db_close(); + + /* + * If error conversion is supported, make sure it is reflected in + * the minimum result sequence of operations. + */ + if (err_conv) { + for (i = 0; i < IHSize; ++i) + for (ip = bhash[i]; ip != NULL; ip = ip->blink) + if (ip->ret_flag & DoesEFail) + ip->min_result = 0; + for (i = 0; i < IHSize; ++i) + for (ip = ohash[i]; ip != NULL; ip = ip->blink) + if (ip->ret_flag & DoesEFail) + ip->min_result = 0; + for (i = 0; i < IHSize; ++i) + for (ip = khash[i]; ip != NULL; ip = ip->blink) + if (ip->ret_flag & DoesEFail) + ip->min_result = 0; + } + } + +/* + * acpt_opt - given a data base entry for an operator determine if it + * is in iconc's operator table. + */ +static int acpt_op(ip) +struct implement *ip; + { + register char *op; + register int opcmp; + + /* + * Calls to this function are in lexical order by operator symbol continue + * searching operator table from where we left off. + */ + op = ip->op; + for (;;) { + /* + * optab has augmented assignments out of lexical order. Skip anything + * which does not expect an implementation. This gets augmented + * assignments out of the way. + */ + while (optr->expected == 0 && optr->tok.t_word != NULL) + ++optr; + if (optr->tok.t_word == NULL) + return chck_spec(ip); + opcmp = strcmp(op, optr->tok.t_word); + if (opcmp > 0) + ++optr; + else if (opcmp < 0) + return chck_spec(ip); + else { + if (ip->nargs == 1 && (optr->expected & Unary)) { + if (optr->unary == NULL) { + optr->unary = ip; + return 1; + } + else + return 0; + } + else if (ip->nargs == 2 && (optr->expected & Binary)) { + if (optr->binary == NULL) { + optr->binary = ip; + return 1; + } + else + return 0; + } + else + return chck_spec(ip); + } + } + } + +/* + * chck_spec - check whether the operator is one that does not use standard + * unary or binary syntax. + */ +static int chck_spec(ip) +struct implement *ip; + { + register char *op; + int indx; + + indx = -1; + op = ip->op; + if (strcmp(op, "...") == 0) { + if (ip->nargs == 2) + indx = ToOp; + else + indx = ToByOp; + } + else if (strcmp(op, "[:]") == 0) + indx = SectOp; + else if (strcmp(op, "[]") == 0) + indx = SubscOp; + else if (strcmp(op, "[...]") == 0) + indx = ListOp; + + if (indx == -1) { + db_err2(0, "unexpected operator (or arity),", op); + return 0; + } + if (spec_op[indx] == NULL) { + spec_op[indx] = ip; + return 1; + } + else + return 0; + } |