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