|
|
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)const.c 1.5 8/29/82";
4:
5: #include "whoami.h"
6: #include "0.h"
7: #include "tree.h"
8:
9: /*
10: * Const enters the definitions
11: * of the constant declaration
12: * part into the namelist.
13: */
14: #ifndef PI1
15: constbeg( lineofyconst , r )
16: int lineofyconst;
17: {
18: static bool const_order = FALSE;
19: static bool const_seen = FALSE;
20:
21: /*
22: * this allows for multiple declaration
23: * parts, unless the "standard" option
24: * has been specified.
25: * If a routine segment is being compiled,
26: * do level one processing.
27: */
28:
29: if (!progseen)
30: level1();
31: line = lineofyconst;
32: if (parts[ cbn ] & (TPRT|VPRT|RPRT)) {
33: if ( opt( 's' ) ) {
34: standard();
35: error("Constant declarations should precede type, var and routine declarations");
36: } else {
37: if ( !const_order ) {
38: const_order = TRUE;
39: warning();
40: error("Constant declarations should precede type, var and routine declarations");
41: }
42: }
43: }
44: if (parts[ cbn ] & CPRT) {
45: if ( opt( 's' ) ) {
46: standard();
47: error("All constants should be declared in one const part");
48: } else {
49: if ( !const_seen ) {
50: const_seen = TRUE;
51: warning();
52: error("All constants should be declared in one const part");
53: }
54: }
55: }
56: parts[ cbn ] |= CPRT;
57: }
58: #endif PI1
59:
60: const(cline, cid, cdecl)
61: int cline;
62: register char *cid;
63: register int *cdecl;
64: {
65: register struct nl *np;
66:
67: #ifdef PI0
68: send(REVCNST, cline, cid, cdecl);
69: #endif
70: line = cline;
71: gconst(cdecl);
72: np = enter(defnl(cid, CONST, con.ctype, con.cival));
73: #ifndef PI0
74: np->nl_flags |= NMOD;
75: #endif
76:
77: #ifdef PC
78: if (cbn == 1) {
79: stabgconst( cid , line );
80: }
81: #endif PC
82:
83: # ifdef PTREE
84: {
85: pPointer Const = ConstDecl( cid , cdecl );
86: pPointer *Consts;
87:
88: pSeize( PorFHeader[ nesting ] );
89: Consts = &( pDEF( PorFHeader[ nesting ] ).PorFConsts );
90: *Consts = ListAppend( *Consts , Const );
91: pRelease( PorFHeader[ nesting ] );
92: }
93: # endif
94: if (con.ctype == NIL)
95: return;
96: if ( con.ctype == nl + TSTR )
97: np->ptr[0] = con.cpval;
98: if (isa(con.ctype, "i"))
99: np->range[0] = con.crval;
100: else if (isa(con.ctype, "d"))
101: np->real = con.crval;
102: }
103:
104: #ifndef PI0
105: #ifndef PI1
106: constend()
107: {
108:
109: }
110: #endif
111: #endif
112:
113: /*
114: * Gconst extracts
115: * a constant declaration
116: * from the tree for it.
117: * only types of constants
118: * are integer, reals, strings
119: * and scalars, the first two
120: * being possibly signed.
121: */
122: gconst(r)
123: int *r;
124: {
125: register struct nl *np;
126: register *cn;
127: char *cp;
128: int negd, sgnd;
129: long ci;
130:
131: con.ctype = NIL;
132: cn = r;
133: negd = sgnd = 0;
134: loop:
135: if (cn == NIL || cn[1] == NIL)
136: return (NIL);
137: switch (cn[0]) {
138: default:
139: panic("gconst");
140: case T_MINUSC:
141: negd = 1 - negd;
142: case T_PLUSC:
143: sgnd++;
144: cn = cn[1];
145: goto loop;
146: case T_ID:
147: np = lookup(cn[1]);
148: if (np == NIL)
149: return;
150: if (np->class != CONST) {
151: derror("%s is a %s, not a constant as required", cn[1], classes[np->class]);
152: return;
153: }
154: con.ctype = np->type;
155: switch (classify(np->type)) {
156: case TINT:
157: con.crval = np->range[0];
158: break;
159: case TDOUBLE:
160: con.crval = np->real;
161: break;
162: case TBOOL:
163: case TCHAR:
164: case TSCAL:
165: con.cival = np->value[0];
166: con.crval = con.cival;
167: break;
168: case TSTR:
169: con.cpval = np->ptr[0];
170: break;
171: case NIL:
172: con.ctype = NIL;
173: return;
174: default:
175: panic("gconst2");
176: }
177: break;
178: case T_CBINT:
179: con.crval = a8tol(cn[1]);
180: goto restcon;
181: case T_CINT:
182: con.crval = atof(cn[1]);
183: if (con.crval > MAXINT || con.crval < MININT) {
184: derror("Constant too large for this implementation");
185: con.crval = 0;
186: }
187: restcon:
188: ci = con.crval;
189: #ifndef PI0
190: if (bytes(ci, ci) <= 2)
191: con.ctype = nl+T2INT;
192: else
193: #endif
194: con.ctype = nl+T4INT;
195: break;
196: case T_CFINT:
197: con.ctype = nl+TDOUBLE;
198: con.crval = atof(cn[1]);
199: break;
200: case T_CSTRNG:
201: cp = cn[1];
202: if (cp[1] == 0) {
203: con.ctype = nl+T1CHAR;
204: con.cival = cp[0];
205: con.crval = con.cival;
206: break;
207: }
208: con.ctype = nl+TSTR;
209: con.cpval = savestr(cp);
210: break;
211: }
212: if (sgnd) {
213: if (isnta(con.ctype, "id"))
214: derror("%s constants cannot be signed", nameof(con.ctype));
215: else {
216: if (negd)
217: con.crval = -con.crval;
218: ci = con.crval;
219: }
220: }
221: }
222:
223: #ifndef PI0
224: isconst(r)
225: register int *r;
226: {
227:
228: if (r == NIL)
229: return (1);
230: switch (r[0]) {
231: case T_MINUS:
232: r[0] = T_MINUSC;
233: r[1] = r[2];
234: return (isconst(r[1]));
235: case T_PLUS:
236: r[0] = T_PLUSC;
237: r[1] = r[2];
238: return (isconst(r[1]));
239: case T_VAR:
240: if (r[3] != NIL)
241: return (0);
242: r[0] = T_ID;
243: r[1] = r[2];
244: return (1);
245: case T_BINT:
246: r[0] = T_CBINT;
247: r[1] = r[2];
248: return (1);
249: case T_INT:
250: r[0] = T_CINT;
251: r[1] = r[2];
252: return (1);
253: case T_FINT:
254: r[0] = T_CFINT;
255: r[1] = r[2];
256: return (1);
257: case T_STRNG:
258: r[0] = T_CSTRNG;
259: r[1] = r[2];
260: return (1);
261: }
262: return (0);
263: }
264: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.