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

/* Copyright (c) 1979 Regents of the University of California */

static	char sccsid[] = "@(#)type.c 1.4 9/4/80";

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

/*
 * Type declaration part
 */
typebeg()
{

/*
 * this allows for multiple
 * declaration parts unless
 * standard option has been
 * specified.
 * If routine segment is being
 * compiled, do level one processing.
 */

#ifndef PI1
	if (!progseen)
		level1();
	if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
	    if ( opt( 's' ) ) {
		standard();
	    } else {
		warning();
	    }
	    error("Type declarations should precede var and routine declarations");
	}
	if (parts[ cbn ] & TPRT) {
	    if ( opt( 's' ) ) {
		standard();
	    } else {
		warning();
	    }
	    error("All types should be declared in one type part");
	}
	parts[ cbn ] |= TPRT;
#endif
	/*
	 * Forechain is the head of a list of types that
	 * might be self referential.  We chain them up and
	 * process them later.
	 */
	forechain = NIL;
#ifdef PI0
	send(REVTBEG);
#endif
}

type(tline, tid, tdecl)
	int tline;
	char *tid;
	register int *tdecl;
{
	register struct nl *np;

	np = gtype(tdecl);
	line = tline;
#ifndef PI0
	enter(defnl(tid, TYPE, np, 0))->nl_flags |= NMOD;
#else
	enter(defnl(tid, TYPE, np, 0));
	send(REVTYPE, tline, tid, tdecl);
#endif

#ifdef PC
	if (cbn == 1) {
	    stabgtype( tid , line );
	}
#endif PC

#	ifdef PTREE
	    {
		pPointer Type = TypeDecl( tid , tdecl );
		pPointer *Types;

		pSeize( PorFHeader[ nesting ] );
		Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes );
		*Types = ListAppend( *Types , Type );
		pRelease( PorFHeader[ nesting ] );
	    }
#	endif
}

typeend()
{

#ifdef PI0
	send(REVTEND);
#endif
	foredecl();
}
\f
/*
 * Return a type pointer (into the namelist)
 * from a parse tree for a type, building
 * namelist entries as needed.
 */
struct nl *
gtype(r)
	register int *r;
{
	register struct nl *np;
	register char *cp;
	register int oline, w;

	if (r == NIL)
		return (NIL);
	oline = line;
	if (r[0] != T_ID)
		oline = line = r[1];
	switch (r[0]) {
		default:
			panic("type");
		case T_TYID:
			r++;
		case T_ID:
			np = lookup(r[1]);
			if (np == NIL)
				break;
			if (np->class != TYPE) {
#ifndef PI1
				error("%s is a %s, not a type as required", r[1], classes[np->class]);
#endif
				np = NIL;
				break;
			}
			np = np->type;
			break;
		case T_TYSCAL:
			np = tyscal(r);
			break;
		case T_TYRANG:
			np = tyrang(r);
			break;
		case T_TYPTR:
			np = defnl(0, PTR, 0, 0 );
			np -> ptr[0] = r[2];
			np->nl_next = forechain;
			forechain = np;
			break;
		case T_TYPACK:
			np = gtype(r[2]);
			break;
		case T_TYARY:
			np = tyary(r);
			break;
		case T_TYREC:
			np = tyrec(r[2], 0);
#			ifdef PTREE
				/*
				 * mung T_TYREC[3] to point to the record
				 * for RecTCopy
				 */
			    r[3] = np;
#			endif
			break;
		case T_TYFILE:
			np = gtype(r[2]);
			if (np == NIL)
				break;
#ifndef PI1
			if (np->nl_flags & NFILES)
				error("Files cannot be members of files");
#endif
			np = defnl(0, FILET, np, 0);
			np->nl_flags |= NFILES;
			break;
		case T_TYSET:
			np = gtype(r[2]);
			if (np == NIL)
				break;
			if (np->type == nl+TDOUBLE) {
#ifndef PI1
				error("Set of real is not allowed");
#endif
				np = NIL;
				break;
			}
			if (np->class != RANGE && np->class != SCAL) {
#ifndef PI1
				error("Set type must be range or scalar, not %s", nameof(np));
#endif
				np = NIL;
				break;
			}
#ifndef PI1
			if (width(np) > 2)
				error("Implementation restriction: sets must be indexed by 16 bit quantities");
#endif
			np = defnl(0, SET, np, 0);
			break;
	}
	line = oline;
	w = lwidth(np);
	if (w >= TOOMUCH) {
		error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes",
			nameof(np), TOOMUCH-1, w-TOOMUCH+1);
		np = NIL;
	}
	return (np);
}

/*
 * Scalar (enumerated) types
 */
tyscal(r)
	int *r;
{
	register struct nl *np, *op, *zp;
	register *v;
	int i;

	np = defnl(0, SCAL, 0, 0);
	np->type = np;
	v = r[2];
	if (v == NIL)
		return (NIL);
	i = -1;
	zp = np;
	for (; v != NIL; v = v[2]) {
		op = enter(defnl(v[1], CONST, np, ++i));
#ifndef PI0
		op->nl_flags |= NMOD;
#endif
		op->value[1] = i;
		zp->chain = op;
		zp = op;
	}
	np->range[1] = i;
	return (np);
}

/*
 * Declare a subrange.
 */
tyrang(r)
	register int *r;
{
	register struct nl *lp, *hp;
	double high;
	int c, c1;

	gconst(r[3]);
	hp = con.ctype;
	high = con.crval;
	gconst(r[2]);
	lp = con.ctype;
	if (lp == NIL || hp == NIL)
		return (NIL);
	if (norange(lp) || norange(hp))
		return (NIL);
	c = classify(lp);
	c1 = classify(hp);
	if (c != c1) {
#ifndef PI1
		error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
#endif
		return (NIL);
	}
	if (c == TSCAL && scalar(lp) != scalar(hp)) {
#ifndef PI1
		error("Scalar types must be identical in subranges");
#endif
		return (NIL);
	}
	if (con.crval > high) {
#ifndef PI1
		error("Range lower bound exceeds upper bound");
#endif
		return (NIL);
	}
	lp = defnl(0, RANGE, hp->type, 0);
	lp->range[0] = con.crval;
	lp->range[1] = high;
	return (lp);
}

norange(p)
	register struct nl *p;
{
	if (isa(p, "d")) {
#ifndef PI1
		error("Subrange of real is not allowed");
#endif
		return (1);
	}
	if (isnta(p, "bcsi")) {
#ifndef PI1
		error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
#endif
		return (1);
	}
	return (0);
}

/*
 * Declare arrays and chain together the dimension specification
 */
struct nl *
tyary(r)
	int *r;
{
	struct nl *np;
	register *tl;
	register struct nl *tp, *ltp;
	int i;

	tp = gtype(r[3]);
	if (tp == NIL)
		return (NIL);
	np = defnl(0, ARRAY, tp, 0);
	np->nl_flags |= (tp->nl_flags) & NFILES;
	ltp = np;
	i = 0;
	for (tl = r[2]; tl != NIL; tl = tl[2]) {
		tp = gtype(tl[1]);
		if (tp == NIL) {
			np = NIL;
			continue;
		}
		if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
#ifndef PI1
			error("Index type for arrays cannot be real");
#endif
			np = NIL;
			continue;
		}
		if (tp->class != RANGE && tp->class != SCAL) {
#ifndef PI1
			error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
#endif
			np = NIL;
			continue;
		}
		if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
#ifndef PI1
			error("Value of dimension specifier too large or small for this implementation");
#endif
			continue;
		}
		tp = nlcopy(tp);
		i++;
		ltp->chain = tp;
		ltp = tp;
	}
	if (np != NIL)
		np->value[0] = i;
	return (np);
}

/*
 * Delayed processing for pointers to
 * allow self-referential and mutually
 * recursive pointer constructs.
 */
foredecl()
{
	register struct nl *p, *q;

	for (p = forechain; p != NIL; p = p->nl_next) {
		if (p->class == PTR && p -> ptr[0] != 0)
		{
			p->type = gtype(p -> ptr[0]);
#ifndef PI1
			if (p->type != NIL && ( ( p->type )->nl_flags & NFILES))
				error("Files cannot be members of dynamic structures");
#endif
#			ifdef PTREE
			{
			    if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
				pPointer	PtrTo = tCopy( p -> ptr[0] );

				pDEF( p -> inTree ).PtrTType = PtrTo;
			    }
			}
#			endif
			p -> ptr[0] = 0;
		}
	}
}
Commit	Line	Data
dea6491f PK	1	/* Copyright (c) 1979 Regents of the University of California */
dea6491f PK	2
31cef89c	3	static char sccsid[] = "@(#)type.c 1.4 9/4/80";
dea6491f PK	4
	5	#include "whoami.h"
	6	#include "0.h"
	7	#include "tree.h"
	8	#include "objfmt.h"
	9
	10	/*
	11	* Type declaration part
	12	*/
	13	typebeg()
	14	{
	15
	16	/*
af97bcfa	17	* this allows for multiple
dea6491f PK	18	* declaration parts unless
	19	* standard option has been
	20	* specified.
	21	* If routine segment is being
	22	* compiled, do level one processing.
	23	*/
	24
	25	#ifndef PI1
af97bcfa PK	26	if (!progseen)
	27	level1();
	28	if ( parts[ cbn ] & ( VPRT \| RPRT ) ) {
	29	if ( opt( 's' ) ) {
dea6491f	30	standard();
af97bcfa PK	31	} else {
	32	warning();
	33	}
	34	error("Type declarations should precede var and routine declarations");
dea6491f	35	}
af97bcfa PK	36	if (parts[ cbn ] & TPRT) {
af97bcfa PK	37	if ( opt( 's' ) ) {
dea6491f	38	standard();
af97bcfa PK	39	} else {
	40	warning();
	41	}
	42	error("All types should be declared in one type part");
dea6491f	43	}
af97bcfa	44	parts[ cbn ] \|= TPRT;
dea6491f PK	45	#endif
	46	/*
	47	* Forechain is the head of a list of types that
	48	* might be self referential. We chain them up and
	49	* process them later.
	50	*/
	51	forechain = NIL;
	52	#ifdef PI0
	53	send(REVTBEG);
	54	#endif
	55	}
	56
	57	type(tline, tid, tdecl)
	58	int tline;
	59	char *tid;
	60	register int *tdecl;
	61	{
	62	register struct nl *np;
	63
	64	np = gtype(tdecl);
	65	line = tline;
	66	#ifndef PI0
	67	enter(defnl(tid, TYPE, np, 0))->nl_flags \|= NMOD;
	68	#else
	69	enter(defnl(tid, TYPE, np, 0));
	70	send(REVTYPE, tline, tid, tdecl);
	71	#endif
	72
	73	#ifdef PC
b721c131	74	if (cbn == 1) {
99f6998f	75	stabgtype( tid , line );
b721c131	76	}
dea6491f PK	77	#endif PC
	78
	79	# ifdef PTREE
	80	{
	81	pPointer Type = TypeDecl( tid , tdecl );
	82	pPointer *Types;
	83
	84	pSeize( PorFHeader[ nesting ] );
	85	Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes );
	86	Types = ListAppend( Types , Type );
	87	pRelease( PorFHeader[ nesting ] );
	88	}
	89	# endif
	90	}
	91
	92	typeend()
	93	{
	94
	95	#ifdef PI0
	96	send(REVTEND);
	97	#endif
	98	foredecl();
	99	}
	100	\f
	101	/*
	102	* Return a type pointer (into the namelist)
	103	* from a parse tree for a type, building
	104	* namelist entries as needed.
	105	*/
	106	struct nl *
	107	gtype(r)
	108	register int *r;
	109	{
	110	register struct nl *np;
	111	register char *cp;
	112	register int oline, w;
	113
	114	if (r == NIL)
	115	return (NIL);
	116	oline = line;
	117	if (r[0] != T_ID)
	118	oline = line = r[1];
	119	switch (r[0]) {
	120	default:
	121	panic("type");
	122	case T_TYID:
	123	r++;
	124	case T_ID:
	125	np = lookup(r[1]);
	126	if (np == NIL)
	127	break;
	128	if (np->class != TYPE) {
	129	#ifndef PI1
	130	error("%s is a %s, not a type as required", r[1], classes[np->class]);
	131	#endif
	132	np = NIL;
	133	break;
	134	}
	135	np = np->type;
	136	break;
	137	case T_TYSCAL:
	138	np = tyscal(r);
	139	break;
	140	case T_TYRANG:
141	np = tyrang(r);
142	break;
143	case T_TYPTR:
144	np = defnl(0, PTR, 0, 0 );
145	np -> ptr[0] = r[2];
146	np->nl_next = forechain;
147	forechain = np;
148	break;
149	case T_TYPACK:
150	np = gtype(r[2]);
151	break;
152	case T_TYARY:
153	np = tyary(r);
154	break;
155	case T_TYREC:
156	np = tyrec(r[2], 0);
157	# ifdef PTREE
158	/*
159	* mung T_TYREC[3] to point to the record
160	* for RecTCopy
161	*/
162	r[3] = np;
163	# endif
164	break;
165	case T_TYFILE:
166	np = gtype(r[2]);
167	if (np == NIL)
168	break;
169	#ifndef PI1
170	if (np->nl_flags & NFILES)
171	error("Files cannot be members of files");
172	#endif
173	np = defnl(0, FILET, np, 0);
174	np->nl_flags \|= NFILES;
175	break;
176	case T_TYSET:
177	np = gtype(r[2]);
178	if (np == NIL)
179	break;
180	if (np->type == nl+TDOUBLE) {
181	#ifndef PI1
182	error("Set of real is not allowed");
183	#endif
184	np = NIL;
185	break;
186	}
187	if (np->class != RANGE && np->class != SCAL) {
188	#ifndef PI1
189	error("Set type must be range or scalar, not %s", nameof(np));
190	#endif
191	np = NIL;
192	break;
193	}
194	#ifndef PI1
195	if (width(np) > 2)
196	error("Implementation restriction: sets must be indexed by 16 bit quantities");
197	#endif
198	np = defnl(0, SET, np, 0);
199	break;
200	}
201	line = oline;
202	w = lwidth(np);
203	if (w >= TOOMUCH) {
204	error("Storage requirement of %s exceeds the implementation limit of %d by %d bytes",
205	nameof(np), TOOMUCH-1, w-TOOMUCH+1);
206	np = NIL;
207	}
208	return (np);
209	}
210
211	/*
212	* Scalar (enumerated) types
213	*/
214	tyscal(r)
215	int *r;
216	{
217	register struct nl np, op, *zp;
218	register *v;
219	int i;
220
221	np = defnl(0, SCAL, 0, 0);
222	np->type = np;
223	v = r[2];
224	if (v == NIL)
225	return (NIL);
226	i = -1;
227	zp = np;
228	for (; v != NIL; v = v[2]) {
229	op = enter(defnl(v[1], CONST, np, ++i));
230	#ifndef PI0
231	op->nl_flags \|= NMOD;
232	#endif
233	op->value[1] = i;
234	zp->chain = op;
235	zp = op;
236	}
237	np->range[1] = i;
238	return (np);
239	}
240
241	/*
242	* Declare a subrange.
243	*/
244	tyrang(r)
245	register int *r;
246	{
247	register struct nl lp, hp;
248	double high;
249	int c, c1;
250
251	gconst(r[3]);
252	hp = con.ctype;
253	high = con.crval;
254	gconst(r[2]);
255	lp = con.ctype;
256	if (lp == NIL \|\| hp == NIL)
257	return (NIL);
258	if (norange(lp) \|\| norange(hp))
259	return (NIL);
260	c = classify(lp);
261	c1 = classify(hp);
262	if (c != c1) {
263	#ifndef PI1
264	error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
265	#endif
266	return (NIL);
267	}
268	if (c == TSCAL && scalar(lp) != scalar(hp)) {
269	#ifndef PI1
270	error("Scalar types must be identical in subranges");
271	#endif
272	return (NIL);
273	}
274	if (con.crval > high) {
275	#ifndef PI1
276	error("Range lower bound exceeds upper bound");
277	#endif
278	return (NIL);
279	}
280	lp = defnl(0, RANGE, hp->type, 0);
281	lp->range[0] = con.crval;
282	lp->range[1] = high;
283	return (lp);
284	}
285
286	norange(p)
287	register struct nl *p;
288	{
289	if (isa(p, "d")) {
290	#ifndef PI1
291	error("Subrange of real is not allowed");
292	#endif
293	return (1);
294	}
295	if (isnta(p, "bcsi")) {
296	#ifndef PI1
297	error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
298	#endif
299	return (1);
300	}
301	return (0);
302	}
303
304	/*
305	* Declare arrays and chain together the dimension specification
306	*/
307	struct nl *
308	tyary(r)
309	int *r;
310	{
311	struct nl *np;
312	register *tl;
313	register struct nl tp, ltp;
314	int i;
315
316	tp = gtype(r[3]);
317	if (tp == NIL)
318	return (NIL);
319	np = defnl(0, ARRAY, tp, 0);
320	np->nl_flags \|= (tp->nl_flags) & NFILES;
321	ltp = np;
322	i = 0;
323	for (tl = r[2]; tl != NIL; tl = tl[2]) {
324	tp = gtype(tl[1]);
325	if (tp == NIL) {
326	np = NIL;
327	continue;
328	}
329	if (tp->class == RANGE && tp->type == nl+TDOUBLE) {
330	#ifndef PI1
331	error("Index type for arrays cannot be real");
332	#endif
333	np = NIL;
334	continue;
335	}
336	if (tp->class != RANGE && tp->class != SCAL) {
337	#ifndef PI1
338	error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
339	#endif
340	np = NIL;
341	continue;
342	}
343	if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
344	#ifndef PI1
345	error("Value of dimension specifier too large or small for this implementation");
346	#endif
347	continue;
348	}
349	tp = nlcopy(tp);
350	i++;
351	ltp->chain = tp;
352	ltp = tp;
353	}
354	if (np != NIL)
355	np->value[0] = i;
356	return (np);
357	}
358
359	/*
360	* Delayed processing for pointers to
361	* allow self-referential and mutually
362	* recursive pointer constructs.
363	*/
364	foredecl()
365	{
366	register struct nl p, q;
367
368	for (p = forechain; p != NIL; p = p->nl_next) {
369	if (p->class == PTR && p -> ptr[0] != 0)
370	{
371	p->type = gtype(p -> ptr[0]);
372	#ifndef PI1
373	if (p->type != NIL && ( ( p->type )->nl_flags & NFILES))
374	error("Files cannot be members of dynamic structures");
375	#endif
376	# ifdef PTREE
377	{
378	if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
379	pPointer PtrTo = tCopy( p -> ptr[0] );
380
381	pDEF( p -> inTree ).PtrTType = PtrTo;
382	}
383	}
384	# endif
385	p -> ptr[0] = 0;
386	}
387	}
388	}