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