home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / msm-2 / iconc.sit / tdbase.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-09-19  |  4.7 KB  |  198 lines  |  [TEXT/MPS ]
  1. /*
  2.  * Routines to access data base of implementation information produced
  3.  *  by rtt.
  4.  */
  5. #include <ctype.h>
  6. #include "::h:gsupport.h"
  7. #include "trans.h"
  8. #include "tlex.h"
  9. #include "tsym.h"
  10. #include "tree.h"
  11. #include "tcode.h"
  12. #include "tproto.h"
  13. #include "globals.h"
  14.  
  15. /*
  16.  * Prototypes.
  17.  */
  18. hidden int chck_spec Params((struct implement *ip));
  19. hidden int acpt_op   Params((struct implement *ip));
  20.  
  21.  
  22. static struct optab *optr; /* pointer into operator table */
  23.  
  24. /*
  25.  * readdb - read data base produced by rtt.
  26.  */
  27. novalue readdb(db_name)
  28. char *db_name;
  29.    {
  30.    char *op, *s;
  31.    int i;
  32.    struct implement *ip;
  33.    char buf[MaxFileName];        /* file name construction buffer */
  34.    struct fileparts *fp;
  35.    unsigned hashval;
  36.  
  37.    fp = fparse(db_name);
  38.    if (*fp->ext == '\0')
  39.       db_name = salloc(makename(buf, NULL, db_name, DBSuffix));
  40.    else if (!smatch(fp->ext, DBSuffix))
  41.       quitf("bad data base name: %s", db_name);
  42.  
  43.    if (!db_open(db_name, &s))
  44.         db_err1(1, "cannot open data base");
  45.  
  46.    if (largeints && (*s == 'N')) {
  47.        twarn("Warning, run-time system does not support large integers", NULL);
  48.        largeints = 0;
  49.        }
  50.  
  51.    /*
  52.     * Read information about functions.
  53.     */
  54.    db_tbl("functions", bhash);
  55.  
  56.    /*
  57.     * Read information about operators.
  58.     */
  59.    optr = optab;
  60.  
  61.    /*
  62.     * read past operators header.
  63.     */
  64.    db_chstr("operators", "operators");
  65.  
  66.    while ((op = db_string()) != NULL) {
  67.       if ((ip = db_impl('O')) == NULL)
  68.          db_err2(1, "no implementation information for operator", op);
  69.       ip->op = op;
  70.       if (acpt_op(ip)) {
  71.          db_code(ip);
  72.          hashval = IHasher(op);
  73.          ip->blink = ohash[hashval];
  74.          ohash[hashval] = ip;
  75.          db_chstr("end", "end");
  76.          }
  77.       else
  78.          db_dscrd(ip);
  79.       }
  80.    db_chstr("endsect", "endsect");
  81.  
  82.    /*
  83.     * Read information about keywords.
  84.     */
  85.    db_tbl("keywords", khash);
  86.  
  87.    db_close();
  88.  
  89.    /*
  90.     * If error conversion is supported, make sure it is reflected in
  91.     *   the minimum result sequence of operations.
  92.     */
  93.    if (err_conv) {
  94.       for (i = 0; i < IHSize; ++i)
  95.          for (ip = bhash[i]; ip != NULL; ip = ip->blink)
  96.             if (ip->ret_flag & DoesEFail)
  97.                ip->min_result = 0;
  98.       for (i = 0; i < IHSize; ++i)
  99.          for (ip = ohash[i]; ip != NULL; ip = ip->blink)
  100.             if (ip->ret_flag & DoesEFail)
  101.                ip->min_result = 0;
  102.       for (i = 0; i < IHSize; ++i)
  103.          for (ip = khash[i]; ip != NULL; ip = ip->blink)
  104.             if (ip->ret_flag & DoesEFail)
  105.                ip->min_result = 0;
  106.       }
  107.    }
  108.  
  109. /*
  110.  * acpt_opt - given a data base entry for an operator determine if it
  111.  *  is in iconc's operator table.
  112.  */
  113. static int acpt_op(ip)
  114. struct implement *ip;
  115.    {
  116.    register char *op;
  117.    register int opcmp;
  118.  
  119.    /*
  120.     * Calls to this function are in lexical order by operator symbol continue
  121.     *  searching operator table  from where we left off.
  122.     */
  123.    op = ip->op;
  124.    for (;;) {
  125.       /*
  126.        * optab has augmented assignments out of lexical order. Skip anything
  127.        *  which does not expect an implementation. This gets augmented
  128.        *  assignments out of the way.
  129.        */
  130.       while (optr->expected == 0 && optr->tok.t_word != NULL)
  131.          ++optr;
  132.       if (optr->tok.t_word == NULL)
  133.          return chck_spec(ip);
  134.       opcmp = strcmp(op, optr->tok.t_word);
  135.       if (opcmp > 0)
  136.          ++optr;
  137.       else if (opcmp < 0)
  138.          return chck_spec(ip);
  139.       else {
  140.          if (ip->nargs == 1 && (optr->expected & Unary)) {
  141.             if (optr->unary == NULL) {
  142.                optr->unary = ip;
  143.                return 1;
  144.                }
  145.             else
  146.                return 0;
  147.             }
  148.          else if (ip->nargs == 2 && (optr->expected & Binary)) {
  149.             if (optr->binary == NULL) {
  150.                optr->binary = ip;
  151.                return 1;
  152.                }
  153.             else
  154.                return 0;
  155.             }
  156.          else
  157.             return chck_spec(ip);
  158.          }
  159.       }
  160.    }
  161.  
  162. /*
  163.  * chck_spec - check whether the operator is one that does not use standard
  164.  *    unary or binary syntax.
  165.  */
  166. static int chck_spec(ip)
  167. struct implement *ip;
  168.    {
  169.    register char *op;
  170.    int indx;
  171.  
  172.    indx = -1;
  173.    op = ip->op;
  174.    if (strcmp(op, "...") == 0) {
  175.       if (ip->nargs == 2)
  176.          indx = ToOp;
  177.       else
  178.          indx = ToByOp;
  179.       }
  180.    else if (strcmp(op, "[:]") == 0)
  181.       indx = SectOp;
  182.    else if (strcmp(op, "[]") == 0)
  183.       indx = SubscOp;
  184.    else if (strcmp(op, "[...]") == 0)
  185.       indx = ListOp;
  186.  
  187.    if (indx == -1) {
  188.       db_err2(0, "unexpected operator (or arity),", op);
  189.       return 0;
  190.       }
  191.    if (spec_op[indx] == NULL) {
  192.       spec_op[indx] = ip;
  193.       return 1;
  194.       }
  195.    else
  196.       return 0;
  197.    }
  198.