home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi0 / yyid.c < prev    next >
C/C++ Source or Header  |  1980-02-17  |  5KB  |  254 lines
  1. /* Copyright (c) 1979 Regents of the University of California */
  2. #
  3. /*
  4.  * pi - Pascal interpreter code translator
  5.  *
  6.  * Charles Haley, Bill Joy UCB
  7.  * Version 1.2 January 1979
  8.  *
  9.  *
  10.  * pxp - Pascal execution profiler
  11.  *
  12.  * Bill Joy UCB
  13.  * Version 1.2 January 1979
  14.  */
  15.  
  16. #include "0.h"
  17. #include "yy.h"
  18.  
  19. #ifdef PI
  20. extern    int *yypv;
  21. /*
  22.  * Determine whether the identifier whose name
  23.  * is "cp" can possibly be a kind, which is a
  24.  * namelist class.  We look through the symbol
  25.  * table for the first instance of cp as a non-field,
  26.  * and at all instances of cp as a field.
  27.  * If any of these are ok, we return true, else false.
  28.  * It would be much better to handle with's correctly,
  29.  * even to just know whether we are in a with at all.
  30.  *
  31.  * Note that we don't disallow constants on the lhs of assignment.
  32.  */
  33. identis(cp, kind)
  34.     register char *cp;
  35.     int kind;
  36. {
  37.     register struct nl *p;
  38.     int i;
  39.  
  40.     /*
  41.      * Cp is NIL when error recovery inserts it.
  42.      */
  43.     if (cp == NIL)
  44.         return (1);
  45.  
  46.     /*
  47.      * Record kind we want for possible later use by yyrecover
  48.      */
  49.     yyidwant = kind;
  50.     yyidhave = NIL;
  51.     i = cp & 077;
  52.     for (p = disptab[i]; p != NIL; p = p->nl_next)
  53.         if (p->symbol == cp) {
  54.             if (yyidok(p, kind))
  55.                 goto gotit;
  56.             if (p->class != FIELD && p->class != BADUSE)
  57.                 break;
  58.         }
  59.     if (p != NIL)
  60.         for (p = p->nl_next; p != NIL; p = p->nl_next)
  61.             if (p->symbol == cp && p->class == FIELD && yyidok(p, kind))
  62.                 goto gotit;
  63.     return (0);
  64. gotit:
  65.     if (p->class == BADUSE && !Recovery) {
  66.         yybadref(p, OY.Yyeline);
  67.         yypv[0] = NIL;
  68.     }
  69.     return (1);
  70. }
  71.  
  72. /*
  73.  * A bad reference to the identifier cp on line
  74.  * line and use implying the addition of kindmask
  75.  * to the mask of kind information.
  76.  */
  77. yybaduse(cp, line, kindmask)
  78.     register char *cp;
  79.     int line, kindmask;
  80. {
  81.     register struct nl *p, *oldp;
  82.     int i;
  83.  
  84.     i = cp & 077;
  85.     for (p = disptab[i]; p != NIL; p = p->nl_next)
  86.         if (p->symbol == cp)
  87.             break;
  88.     oldp = p;
  89.     if (p == NIL || p->class != BADUSE)
  90.         p = enter(defnl(cp, BADUSE, 0, 0));
  91.     p->value[NL_KINDS] =| kindmask;
  92.     yybadref(p, line);
  93.     return (oldp);
  94. }
  95.  
  96. struct    udinfo ud { 'XX', 'XX', 0};
  97. /*
  98.  * Record a reference to an undefined identifier,
  99.  * or one which is improperly used.
  100.  */
  101. yybadref(p, line)
  102.     register struct nl *p;
  103.     int line;
  104. {
  105.     register struct udinfo *udp;
  106.  
  107.     if (p->chain != NIL && p->chain->ud_line == line)
  108.         return;
  109.     udp = esavestr(&ud);
  110.     udp->ud_line = line;
  111.     udp->ud_next = p->chain;
  112.     p->chain = udp;
  113. }
  114.  
  115. #define    varkinds    ((1<<CONST)|(1<<VAR)|(1<<REF)|(1<<ARRAY)|(1<<PTR)|(1<<RECORD)|(1<<FIELD)|(1<<FUNC)|(1<<FVAR))
  116. /*
  117.  * Is the symbol in the p entry of the namelist
  118.  * even possibly a kind kind?  If not, update
  119.  * what we have based on this encounter.
  120.  */
  121. yyidok(p, kind)
  122.     register struct nl *p;
  123.     int kind;
  124. {
  125.  
  126.     if (p->class == BADUSE) {
  127.         if (kind == VAR)
  128.             return (p->value[0] & varkinds);
  129.         return (p->value[0] & (1 << kind));
  130.     }
  131.     if (yyidok1(p, kind))
  132.         return (1);
  133.     if (yyidhave != NIL)
  134.         yyidhave = IMPROPER;
  135.     else
  136.         yyidhave = p->class;
  137.     return (0);
  138. }
  139.  
  140. yyidok1(p, kind)
  141.     register struct nl *p;
  142.     int kind;
  143. {
  144.     int i;
  145.  
  146.     switch (kind) {
  147.         case FUNC:
  148.             if (p->class == FVAR)
  149.                 return(1);
  150.         case CONST:
  151.         case TYPE:
  152.         case PROC:
  153.         case FIELD:
  154.             return (p->class == kind);
  155.         case VAR:
  156.             return (p->class == CONST || yyisvar(p, NIL));
  157.         case ARRAY:
  158.         case RECORD:
  159.             return (yyisvar(p, kind));
  160.         case PTRFILE:
  161.             return (yyisvar(p, PTR) || yyisvar(p, FILE));
  162.     }
  163. }
  164.  
  165. yyisvar(p, class)
  166.     register struct nl *p;
  167.     int class;
  168. {
  169.  
  170.     switch (p->class) {
  171.         case FIELD:
  172.         case VAR:
  173.         case REF:
  174.         case FVAR:
  175.         /*
  176.          * We would prefer to return
  177.          * parameterless functions only.
  178.          */
  179.         case FUNC:
  180.             return (class == NIL || (p->type != NIL && p->type->class == class));
  181.     }
  182.     return (0);
  183. }
  184. #endif
  185. #ifdef PXP
  186. #ifndef DEBUG
  187. identis()
  188. {
  189.  
  190.     return (1);
  191. }
  192. #endif
  193. #ifdef DEBUG
  194. extern    char *classes[];
  195.  
  196. char    kindchars[]    "UCTVAQRDPF";
  197. /*
  198.  * Fake routine "identis" for pxp when testing error recovery.
  199.  * Looks at letters in variable names to answer questions
  200.  * about attributes.  Mapping is
  201.  *    C    const_id
  202.  *    T    type_id
  203.  *    V    var_id        also if any of AQRDF
  204.  *    A    array_id
  205.  *    Q    ptr_id
  206.  *    R    record_id
  207.  *    D    field_id    D for "dot"
  208.  *    P    proc_id
  209.  *    F    func_id
  210.  */
  211. identis(cp, kind)
  212.     register char *cp;
  213.     int kind;
  214. {
  215.     register char *dp;
  216.     char kindch;
  217.  
  218.     /*
  219.      * Don't do anything unless -T
  220.      */
  221.     if (!typetest)
  222.         return (1);
  223.  
  224.     /*
  225.      * Inserted symbols are always correct
  226.      */
  227.     if (cp == NIL)
  228.         return (1);
  229.     /*
  230.      * Set up the names for error messages
  231.      */
  232.     yyidwant = classes[kind];
  233.     for (dp = kindchars; *dp; dp++)
  234.         if (any(cp, *dp)) {
  235.             yyidhave = classes[dp - kindchars];
  236.             break;
  237.         }
  238.  
  239.     /*
  240.      * U in the name means undefined
  241.      */
  242.     if (any(cp, 'U'))
  243.         return (0);
  244.  
  245.     kindch = kindchars[kind];
  246.     if (kindch == 'V')
  247.         for (dp = "AQRDF"; *dp; dp++)
  248.             if (any(cp, *dp))
  249.                 return (1);
  250.     return (any(cp, kindch));
  251. }
  252. #endif
  253. #endif
  254.