1 /*
2  * Copyright (c) 1980 Regents of the University of California.
3  * All rights reserved.  The Berkeley software License Agreement
4  * specifies the terms and conditions for redistribution.
5  */
6 
7 #ifndef lint
8 static char sccsid[] = "@(#)printdecl.c	5.1 (Berkeley) 06/06/85";
9 #endif not lint
10 *
11  * Print out the type of a symbol.
12  */
13 
14 #include "defs.h"
15 #include "sym.h"
16 #include "symtab.h"
17 #include "tree.h"
18 #include "btypes.h"
19 #include "classes.h"
20 #include "sym.rep"
21 
22 printdecl(s)
23 SYM *s;
24 {
25     register SYM *t;
26     BOOLEAN semicolon;
27 
28     semicolon = TRUE;
29     switch(s->class) {
30 	case CONST:
31 	    t = rtype(s->type);
32 	    if (t->class == SCAL) {
33 		printf("(enumeration constant, ord %ld)", s->symvalue.iconval);
34 	    } else {
35 		printf("const %s = ", s->symbol);
36 		if (t == t_real) {
37 		    printf("%g", s->symvalue.fconval);
38 		} else {
39 		    printordinal(s->symvalue.iconval, t);
40 		}
41 	    }
42 	    break;
43 
44 	case TYPE:
45 	    printf("type %s = ", s->symbol);
46 	    printtype(s, s->type);
47 	    break;
48 
49 	case VAR:
50 	    if (isparam(s)) {
51 		printf("(parameter) %s : ", s->symbol);
52 	    } else {
53 		printf("var %s : ", s->symbol);
54 	    }
55 	    printtype(s, s->type);
56 	    break;
57 
58 	case REF:
59 	    printf("(var parameter) %s : ", s->symbol);
60 	    printtype(s, s->type);
61 	    break;
62 
63 	case RANGE:
64 	case ARRAY:
65 	case RECORD:
66 	case VARNT:
67 	case PTR:
68 	    printtype(s, s);
69 	    semicolon = FALSE;
70 	    break;
71 
72 	case FVAR:
73 	    printf("(function variable) %s : ", s->symbol);
74 	    printtype(s, s->type);
75 	    break;
76 
77 	case FIELD:
78 	    printf("(field) %s : ", s->symbol);
79 	    printtype(s, s->type);
80 	    break;
81 
82 	case PROC:
83 	    printf("procedure %s", s->symbol);
84 	    listparams(s);
85 	    break;
86 
87 	case PROG:
88 	    printf("program %s", s->symbol);
89 	    t = s->chain;
90 	    if (t != NIL) {
91 		printf("(%s", t->symbol);
92 		for (t = t->chain; t != NIL; t = t->chain) {
93 		    printf(", %s", t->symbol);
94 		}
95 		printf(")");
96 	    }
97 	    break;
98 
99 	case FUNC:
100 	    printf("function %s", s->symbol);
101 	    listparams(s);
102 	    printf(" : ");
103 	    printtype(s, s->type);
104 	    break;
105 
106 	default:
107 	    error("class %s in printdecl", classname(s));
108     }
109     if (semicolon) {
110 	putchar(';');
111     }
112     putchar('\n');
113 }
114 
115 /*
116  * Recursive whiz-bang procedure to print the type portion
117  * of a declaration.  Doesn't work quite right for variant records.
118  *
119  * The symbol associated with the type is passed to allow
120  * searching for type names without getting "type blah = blah".
121  */
122 
123 LOCAL printtype(s, t)
124 SYM *s;
125 SYM *t;
126 {
127     register SYM *tmp;
128     long r0, r1;
129 
130     tmp = findtype(t);
131     if (tmp != NIL && tmp != s) {
132 	printf("%s", tmp->symbol);
133 	return;
134     }
135     switch(t->class) {
136 	case VAR:
137 	case CONST:
138 	case FUNC:
139 	case PROC:
140 	    panic("printtype: class %s", classname(t));
141 	    break;
142 
143 	case ARRAY:
144 	    printf("array[");
145 	    tmp = t->chain;
146 	    for (;;) {
147 		printtype(tmp, tmp);
148 		tmp = tmp->chain;
149 		if (tmp == NIL) {
150 		    break;
151 		}
152 		printf(", ");
153 	    }
154 	    printf("] of ");
155 	    printtype(t, t->type);
156 	    break;
157 
158 	case RECORD:
159 	    printf("record\n");
160 	    if (t->chain != NIL) {
161 		printtype(t->chain, t->chain);
162 	    }
163 	    printf("end");
164 	    break;
165 
166 	case FIELD:
167 	    if (t->chain != NIL) {
168 		printtype(t->chain, t->chain);
169 	    }
170 	    printf("\t%s : ", t->symbol);
171 	    printtype(t, t->type);
172 	    printf(";\n");
173 	    break;
174 
175 	case RANGE:
176 	    r0 = t->symvalue.rangev.lower;
177 	    r1 = t->symvalue.rangev.upper;
178 	    printordinal(r0, rtype(t->type));
179 	    printf("..");
180 	    printordinal(r1, rtype(t->type));
181 	    break;
182 
183 	case PTR:
184 	    putchar('^');
185 	    printtype(t, t->type);
186 	    break;
187 
188 	case TYPE:
189 	    if (t->symbol != NIL) {
190 		printf("%s", t->symbol);
191 	    } else {
192 		printtype(t, t->type);
193 	    }
194 	    break;
195 
196 	case SCAL:
197 	    printf("(");
198 	    t = t->type->chain;
199 	    if (t != NIL) {
200 		printf("%s", t->symbol);
201 		t = t->chain;
202 		while (t != NIL) {
203 		    printf(", %s", t->symbol);
204 		    t = t->chain;
205 		}
206 	    } else {
207 		panic("empty enumeration");
208 	    }
209 	    printf(")");
210 	    break;
211 
212 	default:
213 	    printf("(class %d)", t->class);
214 	    break;
215     }
216 }
217 
218 /*
219  * List the parameters of a procedure or function.
220  * No attempt is made to combine like types.
221  */
222 
223 listparams(s)
224 SYM *s;
225 {
226     SYM *t;
227 
228     if (s->chain != NIL) {
229 	putchar('(');
230 	for (t = s->chain; t != NIL; t = t->chain) {
231 	    switch (t->class) {
232 		case REF:
233 		    printf("var ");
234 		    break;
235 
236 		case FPROC:
237 		    printf("procedure ");
238 		    break;
239 
240 		case FFUNC:
241 		    printf("function ");
242 		    break;
243 
244 		case VAR:
245 		    break;
246 
247 		default:
248 		    panic("unexpected class %d for parameter", t->class);
249 	    }
250 	    printf("%s : ", t->symbol);
251 	    printtype(t, t->type);
252 	    if (t->chain != NIL) {
253 		printf("; ");
254 	    }
255 	}
256 	putchar(')');
257     }
258 }
259