# 2.11BSD#431 - /usr/src/ucb/pascal/pi/cset.c

##### Functions

    cset              X

       1: /*	@(#)cset.c	2.2	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 November 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15:
      16: /*
      17:  * Constant set constructor.
      18:  * settype is the type of the
      19:  * set if we think that we know it
      20:  * if not we try our damndest to figure
      21:  * out what the type should be.
      22:  */
      23: struct nl *
      24: cset(r, settype, x)
      25:     int *r;
      26:     struct nl *settype;
      27:     int x;
      28: {
      29:     register *e;
      30:     register struct nl *t, *exptype;
      31:     int n, *el;
      32:
      33:     if (settype == NIL) {
      34:         /*
      35: 		 * So far we have no indication
      36: 		 * of what the set type should be.
      37: 		 * We "look ahead" and try to infer
      38: 		 * The type of the constant set
      39: 		 * by evaluating one of its members.
      40: 		 */
      41:         e = r[2];
      42:         if (e == NIL)
      43:             return (nl+TSET);   /* tenative for [] */
      44:         e = e[1];
      45:         if (e == NIL)
      46:             return (NIL);
      47:         if (e[0] == T_RANG)
      48:             e = e[1];
      49:         codeoff();
      50:         t = rvalue(e, NIL);
      51:         codeon();
      52:         if (t == NIL)
      53:             return (NIL);
      54:         /*
      55: 		 * The type of the set, settype, is
      56: 		 * deemed to be a set of the base type
      57: 		 * of t, which we call exptype.  If,
      58: 		 * however, this would involve a
      59: 		 * "set of integer", we cop out
      60: 		 * and use "intset"'s current scoped
      61: 		 * type instead.
      62: 		 */
      63:         if (isa(t, "r")) {
      64:             error("Sets may not have 'real' elements");
      65:             return (NIL);
      66:         }
      67:         if (isnta(t, "bcsi")) {
      68:             error("Set elements must be scalars, not %ss", nameof(t));
      69:             return (NIL);
      70:         }
      71:         if (isa(t, "i")) {
      72:             settype = lookup(intset);
      73:             if (settype == NIL)
      74:                 panic("intset");
      75:             settype = settype->type;
      76:             if (settype == NIL)
      77:                 return (NIL);
      78:             if (isnta(settype, "t")) {
      79:                 error("Set default type \"intset\" is not a set");
      80:                 return (NIL);
      81:             }
      82:             exptype = settype->type;
      83:         } else {
      84:             exptype = t->type;
      85:             if (exptype == NIL)
      86:                 return (NIL);
      87:             if (exptype->class != RANGE)
      88:                 exptype = exptype->type;
      89:             settype = defnl(0, SET, exptype, 0);
      90:         }
      91:     } else {
      92:         if (settype->class != SET) {
      93:             /*
      94: 			 * e.g string context [1,2] = 'abc'
      95: 			 */
      96:             error("Constant set involved in non set context");
      97:             return (NIL);
      98:         }
      99:         exptype = settype->type;
     100:     }
     101:     if (x == NIL)
     102:         put2(O_PUSH, -width(settype));
     103:     n = 0;
     104:     for (el=r[2]; el; el=el[2]) {
     105:         n++;
     106:         e = el[1];
     107:         if (e == NIL)
     108:             return (NIL);
     109:         if (e[0] == T_RANG) {
     110:             t = rvalue(e[2], NIL);
     111:             if (t == NIL) {
     112:                 rvalue(e[1], NIL);
     113:                 continue;
     114:             }
     115:             if (incompat(t, exptype, e[2]))
     116:                 cerror("Upper bound of element type clashed with set type in constant set");
     117:             else
     118:                 convert(t, nl+T2INT);
     119:             t = rvalue(e[1], NIL);
     120:             if (t == NIL)
     121:                 continue;
     122:             if (incompat(t, exptype, e[1]))
     123:                 cerror("Lower bound of element type clashed with set type in constant set");
     124:             else
     125:                 convert(t, nl+T2INT);
     126:         } else {
     127:             t = rvalue((int *) e, NLNIL);
     128:             if (t == NIL)
     129:                 continue;
     130:             if (incompat(t, exptype, e))
     131:                 cerror("Element type clashed with set type in constant set");
     132:             else
     133:                 convert(t, nl+T2INT);
     134:             put1(O_SDUP);
     135:         }
     136:     }
     137:     if (x == NIL) {
     138:         setran(exptype);
     139:         put(4, O_CTTOT, n, set.lwrb, set.uprbp);
     140:     } else
     141:         put2(O_CON2, n);
     142:     return (settype);
     143: }

#### Defined functions

cset defined in line 23; used 3 times

- in /usr/src/ucb/pascal/pi/0.h line 637
- in /usr/src/ucb/pascal/pi/rval.c line 219, 454

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 650 |