[unix-history] / usr / src / cmd / pxp / type.c

/* Copyright (c) 1979 Regents of the University of California */
#
/*
 * pxp - Pascal execution profiler
 *
 * Bill Joy UCB
 * Version 1.2 January 1979
 */

#include "0.h"
#include "tree.h"

STATIC	int typecnt -1;
/*
 * Type declaration part
 */
typebeg(l, tline)
	int l, tline;
{

	line = l;
	if (nodecl)
		printoff();
	puthedr();
	putcm();
	ppnl();
	indent();
	ppkw("type");
	ppgoin(DECL);
	typecnt = 0;
	setline(tline);
}

type(tline, tid, tdecl)
	int tline;
	char *tid;
	int *tdecl;
{

	if (typecnt)
		putcm();
	setline(tline);
	ppitem();
	ppid(tid);
	ppsep(" =");
	gtype(tdecl);
	ppsep(";");
	setinfo(tline);
	putcml();
	typecnt++;
}

typeend()
{

	if (typecnt == -1)
		return;
	if (typecnt == 0)
		ppid("{type decls}");
	ppgoout(DECL);
	typecnt = -1;
}

/*
 * A single type declaration
 */
gtype(r)
	register int *r;
{

	if (r == NIL) {
		ppid("{type}");
		return;
	}
	if (r[0] != T_ID && r[0] != T_TYPACK)
		setline(r[1]);
	switch (r[0]) {
		default:
			panic("type");
		case T_ID:
			ppspac();
			ppid(r[1]);
			return;
		case T_TYID:
			ppspac();
			ppid(r[2]);
			break;
		case T_TYSCAL:
			ppspac();
			tyscal(r);
			break;
		case T_TYRANG:
			ppspac();
			tyrang(r);
			break;
		case T_TYPTR:
			ppspac();
			ppop("^");
			gtype(r[2]);
			break;
		case T_TYPACK:
			ppspac();
			ppkw("packed");
			gtype(r[2]);
			break;
		case T_TYARY:
			ppspac();
			tyary(r);
			break;
		case T_TYREC:
			ppspac();
			tyrec(r[2], NIL);
			break;
		case T_TYFILE:
			ppspac();
			ppkw("file");
			ppspac();
			ppkw("of");
			gtype(r[2]);
			break;
		case T_TYSET:
			ppspac();
			ppkw("set");
			ppspac();
			ppkw("of");
			gtype(r[2]);
			break;
	}
	setline(r[1]);
	putcml();
}

/*
 * Scalar type declaration
 */
tyscal(r)
	register int *r;
{
	register int i;

	ppsep("(");
	r = r[2];
	if (r != NIL) {
		i = 0;
		ppgoin(DECL);
		for (;;) {
			ppid(r[1]);
			r = r[2];
			if (r == NIL)
				break;
			ppsep(", ");
			i++;
			if (i == 7) {
				ppitem();
				i = 0;
			}
		}
		ppgoout(DECL);
	} else
		ppid("{constant list}");
	ppsep(")");
}

/*
 * Subrange type declaration
 */
tyrang(r)
	register int *r;
{

	gconst(r[2]);
	ppsep("..");
	gconst(r[3]);
}

/*
 * Array type declaration
 */
tyary(r)
	register int *r;
{
	register int *tl;

	ppkw("array");
	ppspac();
	ppsep("[");
	tl = r[2];
	if (tl != NIL) {
		ppunspac();
		for (;;) {
			gtype(tl[1]);
			tl = tl[2];
			if (tl == NIL)
				break;
			ppsep(",");
		}
	} else
		ppid("{subscr list}");
	ppsep("]");
	ppspac();
	ppkw("of");
	gtype(r[3]);
}
Commit	Line	Data
427cd046 BJ	1	/* Copyright (c) 1979 Regents of the University of California */
	2	#
	3	/*
	4	* pxp - Pascal execution profiler
	5	*
	6	* Bill Joy UCB
	7	* Version 1.2 January 1979
	8	*/
	9
	10	#include "0.h"
	11	#include "tree.h"
	12
	13	STATIC int typecnt -1;
	14	/*
	15	* Type declaration part
	16	*/
	17	typebeg(l, tline)
	18	int l, tline;
	19	{
	20
	21	line = l;
	22	if (nodecl)
	23	printoff();
	24	puthedr();
	25	putcm();
	26	ppnl();
	27	indent();
	28	ppkw("type");
	29	ppgoin(DECL);
	30	typecnt = 0;
	31	setline(tline);
	32	}
	33
	34	type(tline, tid, tdecl)
	35	int tline;
	36	char *tid;
	37	int *tdecl;
	38	{
	39
	40	if (typecnt)
	41	putcm();
	42	setline(tline);
	43	ppitem();
	44	ppid(tid);
	45	ppsep(" =");
	46	gtype(tdecl);
	47	ppsep(";");
	48	setinfo(tline);
	49	putcml();
	50	typecnt++;
	51	}
	52
	53	typeend()
	54	{
	55
	56	if (typecnt == -1)
	57	return;
	58	if (typecnt == 0)
	59	ppid("{type decls}");
	60	ppgoout(DECL);
	61	typecnt = -1;
	62	}
	63
	64	/*
65	* A single type declaration
66	*/
67	gtype(r)
68	register int *r;
69	{
70
71	if (r == NIL) {
72	ppid("{type}");
73	return;
74	}
75	if (r[0] != T_ID && r[0] != T_TYPACK)
76	setline(r[1]);
77	switch (r[0]) {
78	default:
79	panic("type");
80	case T_ID:
81	ppspac();
82	ppid(r[1]);
83	return;
84	case T_TYID:
85	ppspac();
86	ppid(r[2]);
87	break;
88	case T_TYSCAL:
89	ppspac();
90	tyscal(r);
91	break;
92	case T_TYRANG:
93	ppspac();
94	tyrang(r);
95	break;
96	case T_TYPTR:
97	ppspac();
98	ppop("^");
99	gtype(r[2]);
100	break;
101	case T_TYPACK:
102	ppspac();
103	ppkw("packed");
104	gtype(r[2]);
105	break;
106	case T_TYARY:
107	ppspac();
108	tyary(r);
109	break;
110	case T_TYREC:
111	ppspac();
112	tyrec(r[2], NIL);
113	break;
114	case T_TYFILE:
115	ppspac();
116	ppkw("file");
117	ppspac();
118	ppkw("of");
119	gtype(r[2]);
120	break;
121	case T_TYSET:
122	ppspac();
123	ppkw("set");
124	ppspac();
125	ppkw("of");
126	gtype(r[2]);
127	break;
128	}
129	setline(r[1]);
130	putcml();
131	}
132
133	/*
134	* Scalar type declaration
135	*/
136	tyscal(r)
137	register int *r;
138	{
139	register int i;
140
141	ppsep("(");
142	r = r[2];
143	if (r != NIL) {
144	i = 0;
145	ppgoin(DECL);
146	for (;;) {
147	ppid(r[1]);
148	r = r[2];
149	if (r == NIL)
150	break;
151	ppsep(", ");
152	i++;
153	if (i == 7) {
154	ppitem();
155	i = 0;
156	}
157	}
158	ppgoout(DECL);
159	} else
160	ppid("{constant list}");
161	ppsep(")");
162	}
163
164	/*
165	* Subrange type declaration
166	*/
167	tyrang(r)
168	register int *r;
169	{
170
171	gconst(r[2]);
172	ppsep("..");
173	gconst(r[3]);
174	}
175
176	/*
177	* Array type declaration
178	*/
179	tyary(r)
180	register int *r;
181	{
182	register int *tl;
183
184	ppkw("array");
185	ppspac();
186	ppsep("[");
187	tl = r[2];
188	if (tl != NIL) {
189	ppunspac();
190	for (;;) {
191	gtype(tl[1]);
192	tl = tl[2];
193	if (tl == NIL)
194	break;
195	ppsep(",");
196	}
197	} else
198	ppid("{subscr list}");
199	ppsep("]");
200	ppspac();
201	ppkw("of");
202	gtype(r[3]);
203	}