[unix-history] / usr / src / usr.bin / pascal / src / type.c

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

#ifndef lint
static char sccsid[] = "@(#)type.c 1.8.1.1 %G%";
#endif

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

/*
 * Type declaration part
 */
/*ARGSUSED*/
typebeg( lineofytype , r )
    int	lineofytype;
{
    static bool	type_order = FALSE;
    static bool	type_seen = FALSE;

/*
 * 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();
	line = lineofytype;
	if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
	    if ( opt( 's' ) ) {
		standard();
		error("Type declarations should precede var and routine declarations");
	    } else {
		if ( !type_order ) {
		    type_order = TRUE;
		    warning();
		    error("Type declarations should precede var and routine declarations");
		}
	    }
	}
	if (parts[ cbn ] & TPRT) {
	    if ( opt( 's' ) ) {
		standard();
		error("All types should be declared in one type part");
	    } else {
		if ( !type_seen ) {
		    type_seen = TRUE;
		    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 struct tnode *tdecl;
{
	register struct nl *np;
	struct nl *tnp;

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

#ifdef PC
	if (cbn == 1) {
	    stabgtype(tid, np, line);
	} else {
	    stabltype(tid, np);
	}
#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 struct tnode *r;
{
	register struct nl *np;
	register int oline;
#ifdef OBJ
	long w;
#endif

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

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

	np = defnl((char *) 0, SCAL, NLNIL, 0);
	np->type = np;
	v = r->comp_ty.type;
	if (v == TR_NIL)
		return (NLNIL);
	i = -1;
	zp = np;
	for (; v != TR_NIL; v = v->list_node.next) {
		op = enter(defnl((char *) v->list_node.list, 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 for conformant arrays.
 */
struct nl *
tycrang(r)
	register struct tnode *r;
{
	register struct nl *p, *op, *tp;

	tp = gtype(r->crang_ty.type);
	if ( tp == NLNIL )
		return (NLNIL);
	/*
	 * Just make a new type -- the lower and upper bounds must be
	 * set by params().
	 */
	p = defnl ( 0, CRANGE, tp, 0 );
	return(p);
}

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

	gconst(r->rang_ty.const2);
	hp = con.ctype;
	high = con.crval;
	gconst(r->rang_ty.const1);
	lp = con.ctype;
	if (lp == NLNIL || hp == NLNIL)
		return (NLNIL);
	if (norange(lp) || norange(hp))
		return (NLNIL);
	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 (NLNIL);
	}
	if (c == TSCAL && scalar(lp) != scalar(hp)) {
#ifndef PI1
		error("Scalar types must be identical in subranges");
#endif
		return (NLNIL);
	}
	if (con.crval > high) {
#ifndef PI1
		error("Range lower bound exceeds upper bound");
#endif
		return (NLNIL);
	}
	lp = defnl((char *) 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)
	struct tnode *r;
{
	struct nl *np;
	register struct tnode *tl, *s;
	register struct nl *tp, *ltp;
	int i, n;

	s = r;
	/* Count the dimensions */
	for (n = 0; s->tag == T_TYARY || s->tag == T_TYCARY;
					s = s->ary_ty.type, n++)
		/* NULL STATEMENT */;
	tp = gtype(s);
	if (tp == NLNIL)
		return (NLNIL);
	np = defnl((char *) 0, ARRAY, tp, 0);
	np->nl_flags |= (tp->nl_flags) & NFILES;
	ltp = np;
	i = 0;
	for (s = r; s->tag == T_TYARY || s->tag == T_TYCARY;
					s = s->ary_ty.type) {
	    for (tl = s->ary_ty.type_list; tl != TR_NIL; tl=tl->list_node.next){
		tp = gtype(tl->list_node.list);
		if (tp == NLNIL) {
			np = NLNIL;
			continue;
		}
		if ((tp->class == RANGE || tp->class == CRANGE) &&
		    tp->type == nl+TDOUBLE) {
#ifndef PI1
			error("Index type for arrays cannot be real");
#endif
			np = NLNIL;
			continue;
		}
		if (tp->class != RANGE && tp->class != SCAL && tp->class !=CRANGE){
#ifndef PI1
			error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
#endif
			np = NLNIL;
			continue;
		}
#ifndef PC
		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;
		}
#endif
		if (tp->class != CRANGE)
			tp = nlcopy(tp);
		i++;
		ltp->chain = tp;
		ltp = tp;
	    }
	}
	if (np != NLNIL)
		np->value[0] = i;
	return (np);
}

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

	for (p = forechain; p != NLNIL; p = p->nl_next) {
		if (p->class == PTR && p -> ptr[0] != 0)
		{
			p->type = gtype((struct tnode *) p -> ptr[0]);
#			ifdef PTREE
			{
			    if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
				pPointer	PtrTo = tCopy( p -> ptr[0] );

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