diff options
Diffstat (limited to 'src/iconc/dbase.c')
-rw-r--r-- | src/iconc/dbase.c | 196 |
1 files changed, 0 insertions, 196 deletions
diff --git a/src/iconc/dbase.c b/src/iconc/dbase.c deleted file mode 100644 index fdd3e50..0000000 --- a/src/iconc/dbase.c +++ /dev/null @@ -1,196 +0,0 @@ -/* - * 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; - } |