[unix-history] / pxp / type.c

#
/*
 * pxp - Pascal execution profiler
 *
 * Bill Joy UCB
 * Version 1.0 August 1977
 */

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

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

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

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

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