1*22526Sdist /*
2*22526Sdist  * Copyright (c) 1980 Regents of the University of California.
3*22526Sdist  * All rights reserved.  The Berkeley software License Agreement
4*22526Sdist  * specifies the terms and conditions for redistribution.
5*22526Sdist  */
65528Slinton 
7*22526Sdist #ifndef lint
8*22526Sdist static char sccsid[] = "@(#)printdecl.c	5.1 (Berkeley) 06/06/85";
9*22526Sdist #endif not lint
10*22526Sdist *
1111066Slinton  * Print out the type of a symbol.
125528Slinton  */
135528Slinton 
145528Slinton #include "defs.h"
155528Slinton #include "sym.h"
165528Slinton #include "symtab.h"
175528Slinton #include "tree.h"
185528Slinton #include "btypes.h"
195528Slinton #include "classes.h"
205528Slinton #include "sym.rep"
215528Slinton 
225528Slinton printdecl(s)
235528Slinton SYM *s;
245528Slinton {
2511066Slinton     register SYM *t;
2611066Slinton     BOOLEAN semicolon;
275528Slinton 
2811066Slinton     semicolon = TRUE;
2911066Slinton     switch(s->class) {
3011066Slinton 	case CONST:
3111066Slinton 	    t = rtype(s->type);
3211066Slinton 	    if (t->class == SCAL) {
3311066Slinton 		printf("(enumeration constant, ord %ld)", s->symvalue.iconval);
3411066Slinton 	    } else {
3511066Slinton 		printf("const %s = ", s->symbol);
3611066Slinton 		if (t == t_real) {
3711066Slinton 		    printf("%g", s->symvalue.fconval);
3811066Slinton 		} else {
3911066Slinton 		    printordinal(s->symvalue.iconval, t);
4011066Slinton 		}
4111066Slinton 	    }
4211066Slinton 	    break;
435528Slinton 
4411066Slinton 	case TYPE:
4511066Slinton 	    printf("type %s = ", s->symbol);
4611066Slinton 	    printtype(s, s->type);
4711066Slinton 	    break;
485528Slinton 
4911066Slinton 	case VAR:
5011066Slinton 	    if (isparam(s)) {
5111066Slinton 		printf("(parameter) %s : ", s->symbol);
5211066Slinton 	    } else {
5311066Slinton 		printf("var %s : ", s->symbol);
5411066Slinton 	    }
5511066Slinton 	    printtype(s, s->type);
5611066Slinton 	    break;
575528Slinton 
5811066Slinton 	case REF:
5911066Slinton 	    printf("(var parameter) %s : ", s->symbol);
6011066Slinton 	    printtype(s, s->type);
6111066Slinton 	    break;
625528Slinton 
6311066Slinton 	case RANGE:
6411066Slinton 	case ARRAY:
6511066Slinton 	case RECORD:
6611066Slinton 	case VARNT:
6711066Slinton 	case PTR:
6811066Slinton 	    printtype(s, s);
6911066Slinton 	    semicolon = FALSE;
7011066Slinton 	    break;
715528Slinton 
7211066Slinton 	case FVAR:
7311066Slinton 	    printf("(function variable) %s : ", s->symbol);
7411066Slinton 	    printtype(s, s->type);
7511066Slinton 	    break;
765528Slinton 
7711066Slinton 	case FIELD:
7811066Slinton 	    printf("(field) %s : ", s->symbol);
7911066Slinton 	    printtype(s, s->type);
8011066Slinton 	    break;
815528Slinton 
8211066Slinton 	case PROC:
8311066Slinton 	    printf("procedure %s", s->symbol);
8411066Slinton 	    listparams(s);
8511066Slinton 	    break;
865528Slinton 
8711066Slinton 	case PROG:
8811066Slinton 	    printf("program %s", s->symbol);
8911066Slinton 	    t = s->chain;
9011066Slinton 	    if (t != NIL) {
9111066Slinton 		printf("(%s", t->symbol);
9211066Slinton 		for (t = t->chain; t != NIL; t = t->chain) {
9311066Slinton 		    printf(", %s", t->symbol);
9411066Slinton 		}
9511066Slinton 		printf(")");
9611066Slinton 	    }
9711066Slinton 	    break;
985528Slinton 
9911066Slinton 	case FUNC:
10011066Slinton 	    printf("function %s", s->symbol);
10111066Slinton 	    listparams(s);
10211066Slinton 	    printf(" : ");
10311066Slinton 	    printtype(s, s->type);
10411066Slinton 	    break;
1055528Slinton 
10611066Slinton 	default:
10711066Slinton 	    error("class %s in printdecl", classname(s));
10811066Slinton     }
10911066Slinton     if (semicolon) {
11011066Slinton 	putchar(';');
11111066Slinton     }
11211066Slinton     putchar('\n');
1135528Slinton }
1145528Slinton 
1155528Slinton /*
1165528Slinton  * Recursive whiz-bang procedure to print the type portion
1175528Slinton  * of a declaration.  Doesn't work quite right for variant records.
1185528Slinton  *
1195528Slinton  * The symbol associated with the type is passed to allow
1205528Slinton  * searching for type names without getting "type blah = blah".
1215528Slinton  */
1225528Slinton 
1235528Slinton LOCAL printtype(s, t)
1245528Slinton SYM *s;
1255528Slinton SYM *t;
1265528Slinton {
12711066Slinton     register SYM *tmp;
12811066Slinton     long r0, r1;
1295528Slinton 
13011066Slinton     tmp = findtype(t);
13111066Slinton     if (tmp != NIL && tmp != s) {
13211066Slinton 	printf("%s", tmp->symbol);
13311066Slinton 	return;
13411066Slinton     }
13511066Slinton     switch(t->class) {
13611066Slinton 	case VAR:
13711066Slinton 	case CONST:
13811066Slinton 	case FUNC:
13911066Slinton 	case PROC:
14011066Slinton 	    panic("printtype: class %s", classname(t));
14111066Slinton 	    break;
1425528Slinton 
14311066Slinton 	case ARRAY:
14411066Slinton 	    printf("array[");
14511066Slinton 	    tmp = t->chain;
14611066Slinton 	    for (;;) {
14711066Slinton 		printtype(tmp, tmp);
14811066Slinton 		tmp = tmp->chain;
14911066Slinton 		if (tmp == NIL) {
15011066Slinton 		    break;
15111066Slinton 		}
15211066Slinton 		printf(", ");
15311066Slinton 	    }
15411066Slinton 	    printf("] of ");
15511066Slinton 	    printtype(t, t->type);
15611066Slinton 	    break;
1575528Slinton 
15811066Slinton 	case RECORD:
15911066Slinton 	    printf("record\n");
16011066Slinton 	    if (t->chain != NIL) {
16111066Slinton 		printtype(t->chain, t->chain);
16211066Slinton 	    }
16311066Slinton 	    printf("end");
16411066Slinton 	    break;
1655528Slinton 
16611066Slinton 	case FIELD:
16711066Slinton 	    if (t->chain != NIL) {
16811066Slinton 		printtype(t->chain, t->chain);
16911066Slinton 	    }
17011066Slinton 	    printf("\t%s : ", t->symbol);
17111066Slinton 	    printtype(t, t->type);
17211066Slinton 	    printf(";\n");
17311066Slinton 	    break;
1745528Slinton 
17511066Slinton 	case RANGE:
17611066Slinton 	    r0 = t->symvalue.rangev.lower;
17711066Slinton 	    r1 = t->symvalue.rangev.upper;
17811066Slinton 	    printordinal(r0, rtype(t->type));
17911066Slinton 	    printf("..");
18011066Slinton 	    printordinal(r1, rtype(t->type));
18111066Slinton 	    break;
1825528Slinton 
18311066Slinton 	case PTR:
18411066Slinton 	    putchar('^');
18511066Slinton 	    printtype(t, t->type);
18611066Slinton 	    break;
1875528Slinton 
18811066Slinton 	case TYPE:
18911066Slinton 	    if (t->symbol != NIL) {
19011066Slinton 		printf("%s", t->symbol);
19111066Slinton 	    } else {
19211066Slinton 		printtype(t, t->type);
19311066Slinton 	    }
19411066Slinton 	    break;
1955528Slinton 
19611066Slinton 	case SCAL:
19711066Slinton 	    printf("(");
19811066Slinton 	    t = t->type->chain;
19911066Slinton 	    if (t != NIL) {
20011066Slinton 		printf("%s", t->symbol);
20111066Slinton 		t = t->chain;
20211066Slinton 		while (t != NIL) {
20311066Slinton 		    printf(", %s", t->symbol);
20411066Slinton 		    t = t->chain;
20511066Slinton 		}
20611066Slinton 	    } else {
20711066Slinton 		panic("empty enumeration");
20811066Slinton 	    }
20911066Slinton 	    printf(")");
21011066Slinton 	    break;
2115528Slinton 
21211066Slinton 	default:
21311066Slinton 	    printf("(class %d)", t->class);
21411066Slinton 	    break;
21511066Slinton     }
2165528Slinton }
2175528Slinton 
2185528Slinton /*
2195528Slinton  * List the parameters of a procedure or function.
2205528Slinton  * No attempt is made to combine like types.
2215528Slinton  */
2225528Slinton 
2235528Slinton listparams(s)
2245528Slinton SYM *s;
2255528Slinton {
22611066Slinton     SYM *t;
2275528Slinton 
22811066Slinton     if (s->chain != NIL) {
22911066Slinton 	putchar('(');
23011066Slinton 	for (t = s->chain; t != NIL; t = t->chain) {
23111066Slinton 	    switch (t->class) {
23211066Slinton 		case REF:
23311066Slinton 		    printf("var ");
23411066Slinton 		    break;
2355528Slinton 
23611066Slinton 		case FPROC:
23711066Slinton 		    printf("procedure ");
23811066Slinton 		    break;
2395528Slinton 
24011066Slinton 		case FFUNC:
24111066Slinton 		    printf("function ");
24211066Slinton 		    break;
2435528Slinton 
24411066Slinton 		case VAR:
24511066Slinton 		    break;
2465528Slinton 
24711066Slinton 		default:
24811066Slinton 		    panic("unexpected class %d for parameter", t->class);
24911066Slinton 	    }
25011066Slinton 	    printf("%s : ", t->symbol);
25111066Slinton 	    printtype(t, t->type);
25211066Slinton 	    if (t->chain != NIL) {
25311066Slinton 		printf("; ");
25411066Slinton 	    }
2555528Slinton 	}
25611066Slinton 	putchar(')');
25711066Slinton     }
2585528Slinton }
259