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