[unix-history] / usr.bin / f2c / put.c

/****************************************************************
Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore.

Permission to use, copy, modify, and distribute this software
and its documentation for any purpose and without fee is hereby
granted, provided that the above copyright notice appear in all
copies and that both that the copyright notice and this
permission notice and warranty disclaimer appear in supporting
documentation, and that the names of AT&T Bell Laboratories or
Bellcore or any of their entities not be used in advertising or
publicity pertaining to distribution of the software without
specific, written prior permission.

AT&T and Bellcore disclaim all warranties with regard to this
software, including all implied warranties of merchantability
and fitness.  In no event shall AT&T or Bellcore be liable for
any special, indirect or consequential damages or any damages
whatsoever resulting from loss of use, data or profits, whether
in an action of contract, negligence or other tortious action,
arising out of or in connection with the use or performance of
this software.
****************************************************************/

/*
 * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
 * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
*/

#include "defs.h"
#include "names.h"		/* For LOCAL_CONST_NAME */
#include "pccdefs.h"
#include "p1defs.h"

/* Definitions for   putconst()   */

#define LIT_CHAR 1
#define LIT_FLOAT 2
#define LIT_INT 3


/*
char *ops [ ] =
	{
	"??", "+", "-", "*", "/", "**", "-",
	"OR", "AND", "EQV", "NEQV", "NOT",
	"CONCAT",
	"<", "==", ">", "<=", "!=", ">=",
	" of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
	" , ", " ? ", " : "
	" abs ", " min ", " max ", " addr ", " indirect ",
	" bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
	};
*/

/* Each of these values is defined in   pccdefs   */

int ops2 [ ] =
{
	P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
	P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
	P2BAD,
	P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
	P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
	P2COMOP, P2QUEST, P2COLON,
	1, P2BAD, P2BAD, P2BAD, P2BAD,
	P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
	P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
	P2BAD, P2BAD, P2BAD, P2BAD,
	1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
	1,1,1,1	/* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
};


setlog()
{
	typesize[TYLOGICAL] = typesize[tylogical];
	typealign[TYLOGICAL] = typealign[tylogical];
}


putexpr(p)
expptr p;
{
/* Write the expression to the p1 file */

	p = (expptr) putx (fixtype (p));
	p1_expr (p);
}


expptr putassign(lp, rp)
expptr lp, rp;
{
	return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
}


void puteq(lp, rp)
expptr lp, rp;
{
	putexpr(mkexpr(OPASSIGN, lp, rp) );
}


/* put code for  a *= b */

expptr putsteq(a, b)
Addrp a, b;
{
	return putx( fixexpr((Exprp)
		mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
}


Addrp mkfield(res, f, ty)
register Addrp res;
char *f;
int ty;
{
    res -> vtype = ty;
    res -> Field = f;
    return res;
} /* mkfield */


Addrp realpart(p)
register Addrp p;
{
	register Addrp q;
	expptr mkrealcon();

	if (p->tag == TADDR
	 && p->uname_tag == UNAM_CONST
	 && ISCOMPLEX (p->vtype))
		return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
			p->user.kludge.vstg1 ? p->user.Const.cds[0]
				: cds(dtos(p->user.Const.cd[0]),CNULL));

	q = (Addrp) cpexpr((expptr) p);
	if( ISCOMPLEX(p->vtype) )
		q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);

	return(q);
}


expptr imagpart(p)
register Addrp p;
{
	register Addrp q;
	expptr mkrealcon();

	if( ISCOMPLEX(p->vtype) )
	{
		if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
			return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
				p->user.kludge.vstg1 ? p->user.Const.cds[1]
				: cds(dtos(p->user.Const.cd[1]),CNULL));
		q = (Addrp) cpexpr((expptr) p);
		q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
		return( (expptr) q );
	}
	else

/* Cast an integer type onto a Double Real type */

		return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
}


/* ncat -- computes the number of adjacent concatenation operations */

ncat(p)
register expptr p;
{
	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
		return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
	else	return(1);
}


/* lencat -- returns the length of the concatenated string.  Each
   substring must have a static (i.e. compile-time) fixed length */

ftnint lencat(p)
register expptr p;
{
	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
		return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
	else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
		return(p->headblock.vleng->constblock.Const.ci);
	else if(p->tag==TADDR && p->addrblock.varleng!=0)
		return(p->addrblock.varleng);
	else
	{
		err("impossible element in concatenation");
		return(0);
	}
}

/* putconst -- Creates a new Addrp value which maps onto the input
   constant value.  The Addrp doesn't retain the value of the constant,
   instead that value is copied into a table of constants (called
   litpool,   for pool of literal values).  The only way to retrieve the
   actual value of the constant is to look at the   memno   field of the
   Addrp result.  You know that the associated literal is the one referred
   to by   q   when   (q -> memno == litp -> litnum).
*/

Addrp putconst(p)
register Constp p;
{
	register Addrp q;
	struct Literal *litp, *lastlit;
	int k, len, type;
	int litflavor;
	double cd[2];
	ftnint nblanks;
	char *strp;
	char cdsbuf0[64], cdsbuf1[64], *ds[2];

	if (p->tag != TCONST)
		badtag("putconst", p->tag);

	q = ALLOC(Addrblock);
	q->tag = TADDR;
	type = p->vtype;
	q->vtype = ( type==TYADDR ? tyint : type );
	q->vleng = (expptr) cpexpr(p->vleng);
	q->vstg = STGCONST;

/* Create the new label for the constant.  This is wasteful of labels
   because when the constant value already exists in the literal pool,
   this label gets thrown away and is never reclaimed.  It might be
   cleaner to move this down past the first   switch()   statement below */

	q->memno = newlabel();
	q->memoffset = ICON(0);
	q -> uname_tag = UNAM_CONST;

/* Copy the constant info into the Addrblock; do this by copying the
   largest storage elts */

	q -> user.Const = p -> Const;
	q->user.kludge.vstg1 = p->vstg;	/* distinguish string from binary fp */

	/* check for value in literal pool, and update pool if necessary */

	k = 1;
	switch(type)
	{
	case TYCHAR:
		if (halign) {
			strp = p->Const.ccp;
			nblanks = p->Const.ccp1.blanks;
			len = p->vleng->constblock.Const.ci;
			litflavor = LIT_CHAR;
			goto loop;
			}
		else
			q->memno = BAD_MEMNO;
		break;
	case TYCOMPLEX:
	case TYDCOMPLEX:
		k = 2;
		if (p->vstg)
			cd[1] = atof(ds[1] = p->Const.cds[1]);
		else
			ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
	case TYREAL:
	case TYDREAL:
		litflavor = LIT_FLOAT;
		if (p->vstg)
			cd[0] = atof(ds[0] = p->Const.cds[0]);
		else
			ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
		goto loop;

	case TYLOGICAL1:
	case TYLOGICAL2:
	case TYLOGICAL:
		type = tylogical;
		goto lit_int_flavor;
	case TYLONG:
		type = tyint;
	case TYSHORT:
	case TYINT1:
#ifdef TYQUAD
	case TYQUAD:
#endif
 lit_int_flavor:
		litflavor = LIT_INT;

/* Scan the literal pool for this constant value.  If this same constant
   has been assigned before, use the same label.  Note that this routine
   does NOT consider two differently-typed constants with the same bit
   pattern to be the same constant */

 loop:
		lastlit = litpool + nliterals;
		for(litp = litpool ; litp<lastlit ; ++litp)

/* Remove this type checking to ensure that all bit patterns are reused */

			if(type == litp->littype) switch(litflavor)
			{
			case LIT_CHAR:
				if (len == (int)litp->litval.litival2[0]
				&& nblanks == litp->litval.litival2[1]
				&& !memcmp(strp, litp->cds[0], len)) {
					q->memno = litp->litnum;
					frexpr((expptr)p);
					q->user.Const.ccp1.ccp0 = litp->cds[0];
					return(q);
					}
				break;
			case LIT_FLOAT:
				if(cd[0] == litp->litval.litdval[0]
				&& !strcmp(ds[0], litp->cds[0])
				&& (k == 1 ||
				    cd[1] == litp->litval.litdval[1]
				    && !strcmp(ds[1], litp->cds[1]))) {
ret:
					q->memno = litp->litnum;
					frexpr((expptr)p);
					return(q);
					}
				break;

			case LIT_INT:
				if(p->Const.ci == litp->litval.litival)
					goto ret;
				break;
			}

/* If there's room in the literal pool, add this new value to the pool */

		if(nliterals < maxliterals)
		{
			++nliterals;

			/* litp   now points to the next free elt */

			litp->littype = type;
			litp->litnum = q->memno;
			switch(litflavor)
			{
			case LIT_CHAR:
				litp->litval.litival2[0] = len;
				litp->litval.litival2[1] = nblanks;
				q->user.Const.ccp = litp->cds[0] =
					memcpy(gmem(len,0), strp, len);
				break;

			case LIT_FLOAT:
				litp->litval.litdval[0] = cd[0];
				litp->cds[0] = copys(ds[0]);
				if (k == 2) {
					litp->litval.litdval[1] = cd[1];
					litp->cds[1] = copys(ds[1]);
					}
				break;

			case LIT_INT:
				litp->litval.litival = p->Const.ci;
				break;
			} /* switch (litflavor) */
		}
		else
			many("literal constants", 'L', maxliterals);

		break;
	case TYADDR:
	    break;
	default:
		badtype ("putconst", p -> vtype);
		break;
	} /* switch */

	if (type != TYCHAR || halign)
	    frexpr((expptr)p);
	return( q );
}
Commit	Line	Data
f1525c23 WH	1	/****************************************************************
	2	Copyright 1990, 1991, 1993 by AT&T Bell Laboratories and Bellcore.
	3
	4	Permission to use, copy, modify, and distribute this software
	5	and its documentation for any purpose and without fee is hereby
	6	granted, provided that the above copyright notice appear in all
	7	copies and that both that the copyright notice and this
	8	permission notice and warranty disclaimer appear in supporting
	9	documentation, and that the names of AT&T Bell Laboratories or
	10	Bellcore or any of their entities not be used in advertising or
	11	publicity pertaining to distribution of the software without
	12	specific, written prior permission.
	13
	14	AT&T and Bellcore disclaim all warranties with regard to this
	15	software, including all implied warranties of merchantability
	16	and fitness. In no event shall AT&T or Bellcore be liable for
	17	any special, indirect or consequential damages or any damages
	18	whatsoever resulting from loss of use, data or profits, whether
	19	in an action of contract, negligence or other tortious action,
	20	arising out of or in connection with the use or performance of
	21	this software.
	22	****************************************************************/
	23
	24	/*
	25	* INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
	26	* JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
	27	*/
	28
	29	#include "defs.h"
	30	#include "names.h" /* For LOCAL_CONST_NAME */
	31	#include "pccdefs.h"
	32	#include "p1defs.h"
	33
	34	/* Definitions for putconst() */
	35
	36	#define LIT_CHAR 1
	37	#define LIT_FLOAT 2
	38	#define LIT_INT 3
	39
	40
	41	/*
	42	char *ops [ ] =
	43	{
	44	"??", "+", "-", "", "/", "*", "-",
	45	"OR", "AND", "EQV", "NEQV", "NOT",
	46	"CONCAT",
	47	"<", "==", ">", "<=", "!=", ">=",
	48	" of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
	49	" , ", " ? ", " : "
	50	" abs ", " min ", " max ", " addr ", " indirect ",
	51	" bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
	52	};
	53	*/
	54
	55	/* Each of these values is defined in pccdefs */
	56
	57	int ops2 [ ] =
	58	{
	59	P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
	60	P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
	61	P2BAD,
	62	P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
	63	P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
	64	P2COMOP, P2QUEST, P2COLON,
65	1, P2BAD, P2BAD, P2BAD, P2BAD,
66	P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
67	P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
68	P2BAD, P2BAD, P2BAD, P2BAD,
69	1,1,1,1,1, /* OPNEG1, OPDMIN, OPDMAX, OPASSIGNI, OPIDENTITY */
70	1,1,1,1 /* OPCHARCAST, OPDABS, OPMIN2, OPMAX2 */
71	};
72
73
74	setlog()
75	{
76	typesize[TYLOGICAL] = typesize[tylogical];
77	typealign[TYLOGICAL] = typealign[tylogical];
78	}
79
80
81	putexpr(p)
82	expptr p;
83	{
84	/* Write the expression to the p1 file */
85
86	p = (expptr) putx (fixtype (p));
87	p1_expr (p);
88	}
89
90
91
92
93
94	expptr putassign(lp, rp)
95	expptr lp, rp;
96	{
97	return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
98	}
99
100
101
102
103	void puteq(lp, rp)
104	expptr lp, rp;
105	{
106	putexpr(mkexpr(OPASSIGN, lp, rp) );
107	}
108
109
110
111
112	/* put code for a = b /
113
114	expptr putsteq(a, b)
115	Addrp a, b;
116	{
117	return putx( fixexpr((Exprp)
118	mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
119	}
120
121
122
123
124	Addrp mkfield(res, f, ty)
125	register Addrp res;
126	char *f;
127	int ty;
128	{
129	res -> vtype = ty;
130	res -> Field = f;
131	return res;
132	} /* mkfield */
133
134
135	Addrp realpart(p)
136	register Addrp p;
137	{
138	register Addrp q;
139	expptr mkrealcon();
140
141	if (p->tag == TADDR
142	&& p->uname_tag == UNAM_CONST
143	&& ISCOMPLEX (p->vtype))
144	return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
145	p->user.kludge.vstg1 ? p->user.Const.cds[0]
146	: cds(dtos(p->user.Const.cd[0]),CNULL));
147
148	q = (Addrp) cpexpr((expptr) p);
149	if( ISCOMPLEX(p->vtype) )
150	q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
151
152	return(q);
153	}
154
155
156
157
158	expptr imagpart(p)
159	register Addrp p;
160	{
161	register Addrp q;
162	expptr mkrealcon();
163
164	if( ISCOMPLEX(p->vtype) )
165	{
166	if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
167	return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
168	p->user.kludge.vstg1 ? p->user.Const.cds[1]
169	: cds(dtos(p->user.Const.cd[1]),CNULL));
170	q = (Addrp) cpexpr((expptr) p);
171	q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
172	return( (expptr) q );
173	}
174	else
175
176	/* Cast an integer type onto a Double Real type */
177
178	return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
179	}
180
181
182
183
184
185	/* ncat -- computes the number of adjacent concatenation operations */
186
187	ncat(p)
188	register expptr p;
189	{
190	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
191	return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
192	else return(1);
193	}
194
195
196
197
198	/* lencat -- returns the length of the concatenated string. Each
199	substring must have a static (i.e. compile-time) fixed length */
200
201	ftnint lencat(p)
202	register expptr p;
203	{
204	if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
205	return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
206	else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
207	return(p->headblock.vleng->constblock.Const.ci);
208	else if(p->tag==TADDR && p->addrblock.varleng!=0)
209	return(p->addrblock.varleng);
210	else
211	{
212	err("impossible element in concatenation");
213	return(0);
214	}
215	}
216
217	/* putconst -- Creates a new Addrp value which maps onto the input
218	constant value. The Addrp doesn't retain the value of the constant,
219	instead that value is copied into a table of constants (called
220	litpool, for pool of literal values). The only way to retrieve the
221	actual value of the constant is to look at the memno field of the
222	Addrp result. You know that the associated literal is the one referred
223	to by q when (q -> memno == litp -> litnum).
224	*/
225
226	Addrp putconst(p)
227	register Constp p;
228	{
229	register Addrp q;
230	struct Literal litp, lastlit;
231	int k, len, type;
232	int litflavor;
233	double cd[2];
234	ftnint nblanks;
235	char *strp;
236	char cdsbuf0[64], cdsbuf1[64], *ds[2];
237
238	if (p->tag != TCONST)
239	badtag("putconst", p->tag);
240
241	q = ALLOC(Addrblock);
242	q->tag = TADDR;
243	type = p->vtype;
244	q->vtype = ( type==TYADDR ? tyint : type );
245	q->vleng = (expptr) cpexpr(p->vleng);
246	q->vstg = STGCONST;
247
248	/* Create the new label for the constant. This is wasteful of labels
249	because when the constant value already exists in the literal pool,
250	this label gets thrown away and is never reclaimed. It might be
251	cleaner to move this down past the first switch() statement below */
252
253	q->memno = newlabel();
254	q->memoffset = ICON(0);
255	q -> uname_tag = UNAM_CONST;
256
257	/* Copy the constant info into the Addrblock; do this by copying the
258	largest storage elts */
259
260	q -> user.Const = p -> Const;
261	q->user.kludge.vstg1 = p->vstg; /* distinguish string from binary fp */
262
263	/* check for value in literal pool, and update pool if necessary */
264
265	k = 1;
266	switch(type)
267	{
268	case TYCHAR:
269	if (halign) {
270	strp = p->Const.ccp;
271	nblanks = p->Const.ccp1.blanks;
272	len = p->vleng->constblock.Const.ci;
273	litflavor = LIT_CHAR;
274	goto loop;
275	}
276	else
277	q->memno = BAD_MEMNO;
278	break;
279	case TYCOMPLEX:
280	case TYDCOMPLEX:
281	k = 2;
282	if (p->vstg)
283	cd[1] = atof(ds[1] = p->Const.cds[1]);
284	else
285	ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
286	case TYREAL:
287	case TYDREAL:
288	litflavor = LIT_FLOAT;
289	if (p->vstg)
290	cd[0] = atof(ds[0] = p->Const.cds[0]);
291	else
292	ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
293	goto loop;
294
295	case TYLOGICAL1:
296	case TYLOGICAL2:
297	case TYLOGICAL:
298	type = tylogical;
299	goto lit_int_flavor;
300	case TYLONG:
301	type = tyint;
302	case TYSHORT:
303	case TYINT1:
304	#ifdef TYQUAD
305	case TYQUAD:
306	#endif
307	lit_int_flavor:
308	litflavor = LIT_INT;
309
310	/* Scan the literal pool for this constant value. If this same constant
311	has been assigned before, use the same label. Note that this routine
312	does NOT consider two differently-typed constants with the same bit
313	pattern to be the same constant */
314
315	loop:
316	lastlit = litpool + nliterals;
317	for(litp = litpool ; litp<lastlit ; ++litp)
318
319	/* Remove this type checking to ensure that all bit patterns are reused */
320
321	if(type == litp->littype) switch(litflavor)
322	{
323	case LIT_CHAR:
324	if (len == (int)litp->litval.litival2[0]
325	&& nblanks == litp->litval.litival2[1]
326	&& !memcmp(strp, litp->cds[0], len)) {
327	q->memno = litp->litnum;
328	frexpr((expptr)p);
329	q->user.Const.ccp1.ccp0 = litp->cds[0];
330	return(q);
331	}
332	break;
333	case LIT_FLOAT:
334	if(cd[0] == litp->litval.litdval[0]
335	&& !strcmp(ds[0], litp->cds[0])
336	&& (k == 1 \|\|
337	cd[1] == litp->litval.litdval[1]
338	&& !strcmp(ds[1], litp->cds[1]))) {
339	ret:
340	q->memno = litp->litnum;
341	frexpr((expptr)p);
342	return(q);
343	}
344	break;
345
346	case LIT_INT:
347	if(p->Const.ci == litp->litval.litival)
348	goto ret;
349	break;
350	}
351
352	/* If there's room in the literal pool, add this new value to the pool */
353
354	if(nliterals < maxliterals)
355	{
356	++nliterals;
357
358	/* litp now points to the next free elt */
359
360	litp->littype = type;
361	litp->litnum = q->memno;
362	switch(litflavor)
363	{
364	case LIT_CHAR:
365	litp->litval.litival2[0] = len;
366	litp->litval.litival2[1] = nblanks;
367	q->user.Const.ccp = litp->cds[0] =
368	memcpy(gmem(len,0), strp, len);
369	break;
370
371	case LIT_FLOAT:
372	litp->litval.litdval[0] = cd[0];
373	litp->cds[0] = copys(ds[0]);
374	if (k == 2) {
375	litp->litval.litdval[1] = cd[1];
376	litp->cds[1] = copys(ds[1]);
377	}
378	break;
379
380	case LIT_INT:
381	litp->litval.litival = p->Const.ci;
382	break;
383	} /* switch (litflavor) */
384	}
385	else
386	many("literal constants", 'L', maxliterals);
387
388	break;
389	case TYADDR:
390	break;
391	default:
392	badtype ("putconst", p -> vtype);
393	break;
394	} /* switch */
395
396	if (type != TYCHAR \|\| halign)
397	frexpr((expptr)p);
398	return( q );
399	}