[unix-history] / usr / src / pgrm / pascal / src / stkrval.c

/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#ifndef lint
static char sccsid[] = "@(#)stkrval.c	5.2 (Berkeley) 11/12/86";
#endif not lint

#include "whoami.h"
#include "0.h"
#include "tree.h"
#include "opcode.h"
#include "objfmt.h"
#include "align.h"
#ifdef PC
#   include <pcc.h>
#endif PC
#include "tree_ty.h"

/*
 * stkrval Rvalue - an expression, and coerce it to be a stack quantity.
 *
 * Contype is the type that the caller would prefer, nand is important
 * if constant sets or constant strings are involved, the latter
 * because of string padding.
 */
/*
 * for the obj version, this is a copy of rvalue hacked to use fancy new
 * push-onto-stack-and-convert opcodes.
 * for the pc version, i just call rvalue and convert if i have to,
 * based on the return type of rvalue.
 */
struct nl *
stkrval(r, contype , required )
	register struct tnode *r;
	struct nl *contype;
	long	required;
{
	register struct nl *p;
	register struct nl *q;
	register char *cp, *cp1;
	register int c, w;
	struct tnode *pt;
	long l;
	union
	{
		double pdouble;
		long   plong[2];
	}f;

	if (r == TR_NIL)
		return (NLNIL);
	if (nowexp(r))
		return (NLNIL);
	/*
	 * The root of the tree tells us what sort of expression we have.
	 */
	switch (r->tag) {

	/*
	 * The constant nil
	 */
	case T_NIL:
#		ifdef OBJ
		    (void) put(2, O_CON14, 0);
#		endif OBJ
#		ifdef PC
		    putleaf( PCC_ICON , 0 , 0 , PCCT_INT , (char *) 0 );
#		endif PC
		return (nl+TNIL);

	case T_FCALL:
	case T_VAR:
		p = lookup(r->var_node.cptr);
		if (p == NLNIL || p->class == BADUSE)
			return (NLNIL);
		switch (p->class) {
		case VAR:
			/*
			 * if a variable is
			 * qualified then get
			 * the rvalue by a
			 * stklval and an ind.
			 */
			if (r->var_node.qual != TR_NIL)
				goto ind;
			q = p->type;
			if (q == NLNIL)
				return (NLNIL);
			if (classify(q) == TSTR)
				return(stklval(r, NOFLAGS));
#			ifdef OBJ
				return (stackRV(p));
#			endif OBJ
#			ifdef PC
			    q = rvalue( r , contype , (int) required );
			    if (isa(q, "sbci")) {
				sconv(p2type(q),PCCT_INT);
			    }
			    return q;
#			endif PC

		case WITHPTR:
		case REF:
			/*
			 * A stklval for these
			 * is actually what one
			 * might consider a rvalue.
			 */
ind:
			q = stklval(r, NOFLAGS);
			if (q == NLNIL)
				return (NLNIL);
			if (classify(q) == TSTR)
				return(q);
#			ifdef OBJ
			    w = width(q);
			    switch (w) {
				    case 8:
					    (void) put(1, O_IND8);
					    return(q);
				    case 4:
					    (void) put(1, O_IND4);
					    return(q);
				    case 2:
					    (void) put(1, O_IND24);
					    return(q);
				    case 1:
					    (void) put(1, O_IND14);
					    return(q);
				    default:
					    (void) put(2, O_IND, w);
					    return(q);
			    }
#			endif OBJ
#			ifdef PC
			    if ( required == RREQ ) {
				putop( PCCOM_UNARY PCC_MUL , p2type( q ) );
				if (isa(q,"sbci")) {
				    sconv(p2type(q),PCCT_INT);
				}
			    }
			    return q;
#			endif PC

		case CONST:
			if (r->var_node.qual != TR_NIL) {
				error("%s is a constant and cannot be qualified", r->var_node.cptr);
				return (NLNIL);
			}
			q = p->type;
			if (q == NLNIL)
				return (NLNIL);
			if (q == nl+TSTR) {
				/*
				 * Find the size of the string
				 * constant if needed.
				 */
				cp = (char *) p->ptr[0];
cstrng:
				cp1 = cp;
				for (c = 0; *cp++; c++)
					continue;
				w = c;
				if (contype != NIL && !opt('s')) {
					if (width(contype) < c && classify(contype) == TSTR) {
						error("Constant string too long");
						return (NLNIL);
					}
					w = width(contype);
				}
#				ifdef OBJ
				    (void) put(2, O_LVCON, lenstr(cp1, w - c));
				    putstr(cp1, w - c);
#				endif OBJ
#				ifdef PC
				    putCONG( cp1 , w , LREQ );
#				endif PC
				/*
				 * Define the string temporarily
				 * so later people can know its
				 * width.
				 * cleaned out by stat.
				 */
				q = defnl((char *) 0, STR, NLNIL, w);
				q->type = q;
				return (q);
			}
			if (q == nl+T1CHAR) {
#			    ifdef OBJ
				(void) put(2, O_CONC4, (int)p->value[0]);
#			    endif OBJ
#			    ifdef PC
				putleaf(PCC_ICON, p -> value[0], 0, PCCT_INT, 
						(char *) 0);
#			    endif PC
			    return(q);
			}
			/*
			 * Every other kind of constant here
			 */
#			ifdef OBJ
			    switch (width(q)) {
			    case 8:
#ifndef DEBUG
				    (void) put(2, O_CON8, p->real);
				    return(q);
#else
				    if (hp21mx) {
					    f.pdouble = p->real;
					    conv((int *) (&f.pdouble));
					    l = f.plong[1];
					    (void) put(2, O_CON4, l);
				    } else
					    (void) put(2, O_CON8, p->real);
				    return(q);
#endif
			    case 4:
				    (void) put(2, O_CON4, p->range[0]);
				    return(q);
			    case 2:
				    (void) put(2, O_CON24, (short)p->range[0]);
				    return(q);
			    case 1:
				    (void) put(2, O_CON14, p->value[0]);
				    return(q);
			    default:
				    panic("stkrval");
			    }
#			endif OBJ
#			ifdef PC
			    q = rvalue( r , contype , (int) required );
			    if (isa(q,"sbci")) {
				sconv(p2type(q),PCCT_INT);
			    }
			    return q;
#			endif PC

		case FUNC:
		case FFUNC:
			/*
			 * Function call
			 */
			pt = r->var_node.qual;
			if (pt != TR_NIL) {
				switch (pt->list_node.list->tag) {
				case T_PTR:
				case T_ARGL:
				case T_ARY:
				case T_FIELD:
					error("Can't qualify a function result value");
					return (NLNIL);
				}
			}
#			ifdef OBJ
			    q = p->type;
			    if (classify(q) == TSTR) {
				    c = width(q);
				    (void) put(2, O_LVCON,
					roundup(c+1, (long) A_SHORT));
				    putstr("", c);
				    (void) put(1, PTR_DUP);
				    p = funccod(r);
				    (void) put(2, O_AS, c);
				    return(p);
			    }
			    p = funccod(r);
			    if (width(p) <= 2)
				    (void) put(1, O_STOI);
#			endif OBJ
#			ifdef PC
			    p = pcfunccod( r );
			    if (isa(p,"sbci")) {
				sconv(p2type(p),PCCT_INT);
			    }
#			endif PC
			return (p);

		case TYPE:
			error("Type names (e.g. %s) allowed only in declarations", p->symbol);
			return (NLNIL);

		case PROC:
		case FPROC:
			error("Procedure %s found where expression required", p->symbol);
			return (NLNIL);
		default:
			panic("stkrvid");
		}
	case T_PLUS:
	case T_MINUS:
	case T_NOT:
	case T_AND:
	case T_OR:
	case T_DIVD:
	case T_MULT:
	case T_SUB:
	case T_ADD:
	case T_MOD:
	case T_DIV:
	case T_EQ:
	case T_NE:
	case T_GE:
	case T_LE:
	case T_GT:
	case T_LT:
	case T_IN:
		p = rvalue(r, contype , (int) required );
#		ifdef OBJ
		    if (width(p) <= 2)
			    (void) put(1, O_STOI);
#		endif OBJ
#		ifdef PC
		    if (isa(p,"sbci")) {
			sconv(p2type(p),PCCT_INT);
		    }
#		endif PC
		return (p);
	case T_CSET:
		p = rvalue(r, contype , (int) required );
		return (p);
	default:
		if (r->const_node.cptr == (char *) NIL)
			return (NLNIL);
		switch (r->tag) {
		default:
			panic("stkrval3");

		/*
		 * An octal number
		 */
		case T_BINT:
			f.pdouble = a8tol(r->const_node.cptr);
			goto conint;
	
		/*
		 * A decimal number
		 */
		case T_INT:
			f.pdouble = atof(r->const_node.cptr);
conint:
			if (f.pdouble > MAXINT || f.pdouble < MININT) {
				error("Constant too large for this implementation");
				return (NLNIL);
			}
			l = f.pdouble;
			if (bytes(l, l) <= 2) {
#			    ifdef OBJ
				(void) put(2, O_CON24, (short)l);
#			    endif OBJ
#			    ifdef PC
				putleaf( PCC_ICON , (short) l , 0 , PCCT_INT , 
						(char *) 0 );
#			    endif PC
				return(nl+T4INT);
			}
#			ifdef OBJ
			    (void) put(2, O_CON4, l); 
#			endif OBJ
#			ifdef PC
			    putleaf( PCC_ICON , (int) l , 0 , PCCT_INT , (char *) 0 );
#			endif PC
			return (nl+T4INT);
	
		/*
		 * A floating point number
		 */
		case T_FINT:
#		   	ifdef OBJ
			    (void) put(2, O_CON8, atof(r->const_node.cptr));
#			endif OBJ
#			ifdef PC
			    putCON8( atof( r->const_node.cptr ) );
#			endif PC
			return (nl+TDOUBLE);
	
		/*
		 * Constant strings.  Note that constant characters
		 * are constant strings of length one; there is
		 * no constant string of length one.
		 */
		case T_STRNG:
			cp = r->const_node.cptr;
			if (cp[1] == 0) {
#				ifdef OBJ
				    (void) put(2, O_CONC4, cp[0]);
#				endif OBJ
#				ifdef PC
				    putleaf( PCC_ICON , cp[0] , 0 , PCCT_INT , 
						(char *) 0 );
#				endif PC
				return(nl+T1CHAR);
			}
			goto cstrng;
		}
	
	}
}

#ifdef OBJ
/*
 * push a value onto the interpreter stack, longword aligned.
 */
struct nl 
*stackRV(p)
	struct nl *p;
{
	struct nl *q;
	int w, bn;

	q = p->type;
	if (q == NLNIL)
		return (NLNIL);
	bn = BLOCKNO(p->nl_block);
	w = width(q);
	switch (w) {
	case 8:
		(void) put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]);
		break;
	case 4:
		(void) put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]);
		break;
	case 2:
		(void) put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]);
		break;
	case 1:
		(void) put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]);
		break;
	default:
		(void) put(3, O_RV | bn << 8+INDX, (int)p->value[0], w);
		break;
	}
	return (q);
}
#endif OBJ
Commit	Line	Data
252367af DF	1	/*
	2	* Copyright (c) 1980 Regents of the University of California.
	3	* All rights reserved. The Berkeley software License Agreement
	4	* specifies the terms and conditions for redistribution.
	5	*/
28e6b83a	6
72fbef68	7	#ifndef lint
ca67e7b4	8	static char sccsid[] = "@(#)stkrval.c 5.2 (Berkeley) 11/12/86";
252367af	9	#endif not lint
28e6b83a PK	10
	11	#include "whoami.h"
	12	#include "0.h"
	13	#include "tree.h"
	14	#include "opcode.h"
	15	#include "objfmt.h"
8d36ce22	16	#include "align.h"
28e6b83a	17	#ifdef PC
c60bfb0d	18	# include <pcc.h>
28e6b83a	19	#endif PC
72fbef68	20	#include "tree_ty.h"
28e6b83a PK	21
	22	/*
	23	* stkrval Rvalue - an expression, and coerce it to be a stack quantity.
	24	*
	25	* Contype is the type that the caller would prefer, nand is important
	26	* if constant sets or constant strings are involved, the latter
	27	* because of string padding.
	28	*/
	29	/*
	30	* for the obj version, this is a copy of rvalue hacked to use fancy new
	31	* push-onto-stack-and-convert opcodes.
	32	* for the pc version, i just call rvalue and convert if i have to,
	33	* based on the return type of rvalue.
	34	*/
	35	struct nl *
	36	stkrval(r, contype , required )
72fbef68	37	register struct tnode *r;
28e6b83a PK	38	struct nl *contype;
	39	long required;
	40	{
	41	register struct nl *p;
	42	register struct nl *q;
	43	register char cp, cp1;
	44	register int c, w;
72fbef68	45	struct tnode *pt;
28e6b83a	46	long l;
72fbef68 RT	47	union
	48	{
	49	double pdouble;
	50	long plong[2];
	51	}f;
28e6b83a	52
72fbef68 RT	53	if (r == TR_NIL)
72fbef68 RT	54	return (NLNIL);
28e6b83a	55	if (nowexp(r))
72fbef68	56	return (NLNIL);
28e6b83a PK	57	/*
	58	* The root of the tree tells us what sort of expression we have.
	59	*/
72fbef68	60	switch (r->tag) {
28e6b83a PK	61
	62	/*
	63	* The constant nil
	64	*/
	65	case T_NIL:
	66	# ifdef OBJ
72fbef68	67	(void) put(2, O_CON14, 0);
28e6b83a PK	68	# endif OBJ
28e6b83a PK	69	# ifdef PC
c60bfb0d	70	putleaf( PCC_ICON , 0 , 0 , PCCT_INT , (char *) 0 );
28e6b83a PK	71	# endif PC
	72	return (nl+TNIL);
	73
	74	case T_FCALL:
	75	case T_VAR:
72fbef68 RT	76	p = lookup(r->var_node.cptr);
	77	if (p == NLNIL \|\| p->class == BADUSE)
	78	return (NLNIL);
28e6b83a PK	79	switch (p->class) {
	80	case VAR:
	81	/*
6cbd3a07	82	* if a variable is
28e6b83a PK	83	* qualified then get
	84	* the rvalue by a
	85	* stklval and an ind.
	86	*/
72fbef68	87	if (r->var_node.qual != TR_NIL)
28e6b83a PK	88	goto ind;
28e6b83a PK	89	q = p->type;
72fbef68 RT	90	if (q == NLNIL)
72fbef68 RT	91	return (NLNIL);
28e6b83a PK	92	if (classify(q) == TSTR)
	93	return(stklval(r, NOFLAGS));
	94	# ifdef OBJ
28ff62b7	95	return (stackRV(p));
28e6b83a PK	96	# endif OBJ
28e6b83a PK	97	# ifdef PC
72fbef68	98	q = rvalue( r , contype , (int) required );
1c91288f	99	if (isa(q, "sbci")) {
c60bfb0d	100	sconv(p2type(q),PCCT_INT);
1c91288f KM	101	}
1c91288f KM	102	return q;
28e6b83a PK	103	# endif PC
	104
	105	case WITHPTR:
	106	case REF:
	107	/*
	108	* A stklval for these
	109	* is actually what one
	110	* might consider a rvalue.
	111	*/
	112	ind:
	113	q = stklval(r, NOFLAGS);
72fbef68 RT	114	if (q == NLNIL)
72fbef68 RT	115	return (NLNIL);
28e6b83a PK	116	if (classify(q) == TSTR)
	117	return(q);
	118	# ifdef OBJ
	119	w = width(q);
	120	switch (w) {
	121	case 8:
72fbef68	122	(void) put(1, O_IND8);
28e6b83a PK	123	return(q);
28e6b83a PK	124	case 4:
72fbef68	125	(void) put(1, O_IND4);
28e6b83a PK	126	return(q);
28e6b83a PK	127	case 2:
72fbef68	128	(void) put(1, O_IND24);
28e6b83a PK	129	return(q);
28e6b83a PK	130	case 1:
72fbef68	131	(void) put(1, O_IND14);
28e6b83a PK	132	return(q);
28e6b83a PK	133	default:
72fbef68	134	(void) put(2, O_IND, w);
28e6b83a PK	135	return(q);
	136	}
	137	# endif OBJ
	138	# ifdef PC
	139	if ( required == RREQ ) {
c60bfb0d	140	putop( PCCOM_UNARY PCC_MUL , p2type( q ) );
1c91288f	141	if (isa(q,"sbci")) {
c60bfb0d	142	sconv(p2type(q),PCCT_INT);
1c91288f	143	}
28e6b83a PK	144	}
	145	return q;
	146	# endif PC
	147
	148	case CONST:
72fbef68 RT	149	if (r->var_node.qual != TR_NIL) {
	150	error("%s is a constant and cannot be qualified", r->var_node.cptr);
	151	return (NLNIL);
28e6b83a PK	152	}
28e6b83a PK	153	q = p->type;
72fbef68 RT	154	if (q == NLNIL)
72fbef68 RT	155	return (NLNIL);
28e6b83a PK	156	if (q == nl+TSTR) {
	157	/*
	158	* Find the size of the string
	159	* constant if needed.
	160	*/
72fbef68	161	cp = (char *) p->ptr[0];
28e6b83a PK	162	cstrng:
	163	cp1 = cp;
	164	for (c = 0; *cp++; c++)
	165	continue;
4e63fd2a	166	w = c;
28e6b83a PK	167	if (contype != NIL && !opt('s')) {
	168	if (width(contype) < c && classify(contype) == TSTR) {
	169	error("Constant string too long");
72fbef68	170	return (NLNIL);
28e6b83a	171	}
4e63fd2a	172	w = width(contype);
28e6b83a PK	173	}
28e6b83a PK	174	# ifdef OBJ
72fbef68	175	(void) put(2, O_LVCON, lenstr(cp1, w - c));
4e63fd2a	176	putstr(cp1, w - c);
28e6b83a PK	177	# endif OBJ
28e6b83a PK	178	# ifdef PC
4e63fd2a	179	putCONG( cp1 , w , LREQ );
28e6b83a PK	180	# endif PC
	181	/*
	182	* Define the string temporarily
	183	* so later people can know its
	184	* width.
	185	* cleaned out by stat.
	186	*/
72fbef68	187	q = defnl((char *) 0, STR, NLNIL, w);
28e6b83a PK	188	q->type = q;
	189	return (q);
	190	}
	191	if (q == nl+T1CHAR) {
	192	# ifdef OBJ
72fbef68	193	(void) put(2, O_CONC4, (int)p->value[0]);
28e6b83a PK	194	# endif OBJ
28e6b83a PK	195	# ifdef PC
c60bfb0d	196	putleaf(PCC_ICON, p -> value[0], 0, PCCT_INT,
72fbef68	197	(char *) 0);
28e6b83a PK	198	# endif PC
	199	return(q);
	200	}
	201	/*
	202	* Every other kind of constant here
	203	*/
	204	# ifdef OBJ
	205	switch (width(q)) {
	206	case 8:
	207	#ifndef DEBUG
72fbef68	208	(void) put(2, O_CON8, p->real);
28e6b83a PK	209	return(q);
	210	#else
	211	if (hp21mx) {
72fbef68 RT	212	f.pdouble = p->real;
	213	conv((int *) (&f.pdouble));
	214	l = f.plong[1];
	215	(void) put(2, O_CON4, l);
28e6b83a	216	} else
72fbef68	217	(void) put(2, O_CON8, p->real);
28e6b83a PK	218	return(q);
	219	#endif
	220	case 4:
72fbef68	221	(void) put(2, O_CON4, p->range[0]);
28e6b83a PK	222	return(q);
28e6b83a PK	223	case 2:
72fbef68	224	(void) put(2, O_CON24, (short)p->range[0]);
28e6b83a PK	225	return(q);
28e6b83a PK	226	case 1:
72fbef68	227	(void) put(2, O_CON14, p->value[0]);
28e6b83a PK	228	return(q);
	229	default:
	230	panic("stkrval");
	231	}
	232	# endif OBJ
	233	# ifdef PC
72fbef68	234	q = rvalue( r , contype , (int) required );
1c91288f	235	if (isa(q,"sbci")) {
c60bfb0d	236	sconv(p2type(q),PCCT_INT);
1c91288f KM	237	}
1c91288f KM	238	return q;
28e6b83a PK	239	# endif PC
	240
	241	case FUNC:
c4e911b6	242	case FFUNC:
28e6b83a PK	243	/*
	244	* Function call
	245	*/
72fbef68 RT	246	pt = r->var_node.qual;
	247	if (pt != TR_NIL) {
	248	switch (pt->list_node.list->tag) {
28e6b83a PK	249	case T_PTR:
	250	case T_ARGL:
	251	case T_ARY:
	252	case T_FIELD:
	253	error("Can't qualify a function result value");
72fbef68	254	return (NLNIL);
28e6b83a PK	255	}
	256	}
	257	# ifdef OBJ
	258	q = p->type;
	259	if (classify(q) == TSTR) {
	260	c = width(q);
8d36ce22 KM	261	(void) put(2, O_LVCON,
8d36ce22 KM	262	roundup(c+1, (long) A_SHORT));
28e6b83a	263	putstr("", c);
72fbef68	264	(void) put(1, PTR_DUP);
28e6b83a	265	p = funccod(r);
72fbef68	266	(void) put(2, O_AS, c);
28e6b83a PK	267	return(p);
	268	}
	269	p = funccod(r);
	270	if (width(p) <= 2)
72fbef68	271	(void) put(1, O_STOI);
28e6b83a PK	272	# endif OBJ
	273	# ifdef PC
	274	p = pcfunccod( r );
1c91288f	275	if (isa(p,"sbci")) {
c60bfb0d	276	sconv(p2type(p),PCCT_INT);
1c91288f	277	}
28e6b83a PK	278	# endif PC
	279	return (p);
	280
	281	case TYPE:
	282	error("Type names (e.g. %s) allowed only in declarations", p->symbol);
72fbef68	283	return (NLNIL);
28e6b83a PK	284
28e6b83a PK	285	case PROC:
c4e911b6	286	case FPROC:
28e6b83a	287	error("Procedure %s found where expression required", p->symbol);
72fbef68	288	return (NLNIL);
28e6b83a PK	289	default:
	290	panic("stkrvid");
	291	}
28e6b83a PK	292	case T_PLUS:
	293	case T_MINUS:
	294	case T_NOT:
	295	case T_AND:
	296	case T_OR:
	297	case T_DIVD:
	298	case T_MULT:
	299	case T_SUB:
	300	case T_ADD:
	301	case T_MOD:
	302	case T_DIV:
	303	case T_EQ:
	304	case T_NE:
	305	case T_GE:
	306	case T_LE:
	307	case T_GT:
	308	case T_LT:
	309	case T_IN:
72fbef68	310	p = rvalue(r, contype , (int) required );
28e6b83a PK	311	# ifdef OBJ
28e6b83a PK	312	if (width(p) <= 2)
72fbef68	313	(void) put(1, O_STOI);
28e6b83a	314	# endif OBJ
1c91288f KM	315	# ifdef PC
1c91288f KM	316	if (isa(p,"sbci")) {
c60bfb0d	317	sconv(p2type(p),PCCT_INT);
1c91288f KM	318	}
1c91288f KM	319	# endif PC
28e6b83a	320	return (p);
a26d837a	321	case T_CSET:
72fbef68	322	p = rvalue(r, contype , (int) required );
a26d837a	323	return (p);
28e6b83a	324	default:
72fbef68 RT	325	if (r->const_node.cptr == (char *) NIL)
	326	return (NLNIL);
	327	switch (r->tag) {
28e6b83a PK	328	default:
	329	panic("stkrval3");
	330
	331	/*
	332	* An octal number
	333	*/
	334	case T_BINT:
72fbef68	335	f.pdouble = a8tol(r->const_node.cptr);
28e6b83a PK	336	goto conint;
	337
	338	/*
	339	* A decimal number
	340	*/
	341	case T_INT:
72fbef68	342	f.pdouble = atof(r->const_node.cptr);
28e6b83a	343	conint:
72fbef68	344	if (f.pdouble > MAXINT \|\| f.pdouble < MININT) {
28e6b83a	345	error("Constant too large for this implementation");
72fbef68	346	return (NLNIL);
28e6b83a	347	}
72fbef68	348	l = f.pdouble;
28e6b83a PK	349	if (bytes(l, l) <= 2) {
28e6b83a PK	350	# ifdef OBJ
72fbef68	351	(void) put(2, O_CON24, (short)l);
28e6b83a PK	352	# endif OBJ
28e6b83a PK	353	# ifdef PC
c60bfb0d	354	putleaf( PCC_ICON , (short) l , 0 , PCCT_INT ,
72fbef68	355	(char *) 0 );
28e6b83a PK	356	# endif PC
	357	return(nl+T4INT);
	358	}
	359	# ifdef OBJ
72fbef68	360	(void) put(2, O_CON4, l);
28e6b83a PK	361	# endif OBJ
28e6b83a PK	362	# ifdef PC
c60bfb0d	363	putleaf( PCC_ICON , (int) l , 0 , PCCT_INT , (char *) 0 );
28e6b83a PK	364	# endif PC
	365	return (nl+T4INT);
	366
	367	/*
	368	* A floating point number
	369	*/
	370	case T_FINT:
	371	# ifdef OBJ
72fbef68	372	(void) put(2, O_CON8, atof(r->const_node.cptr));
28e6b83a PK	373	# endif OBJ
28e6b83a PK	374	# ifdef PC
72fbef68	375	putCON8( atof( r->const_node.cptr ) );
28e6b83a PK	376	# endif PC
	377	return (nl+TDOUBLE);
	378
	379	/*
	380	* Constant strings. Note that constant characters
	381	* are constant strings of length one; there is
	382	* no constant string of length one.
	383	*/
	384	case T_STRNG:
72fbef68	385	cp = r->const_node.cptr;
28e6b83a PK	386	if (cp[1] == 0) {
28e6b83a PK	387	# ifdef OBJ
72fbef68	388	(void) put(2, O_CONC4, cp[0]);
28e6b83a PK	389	# endif OBJ
28e6b83a PK	390	# ifdef PC
c60bfb0d	391	putleaf( PCC_ICON , cp[0] , 0 , PCCT_INT ,
72fbef68	392	(char *) 0 );
28e6b83a PK	393	# endif PC
	394	return(nl+T1CHAR);
	395	}
	396	goto cstrng;
	397	}
	398
	399	}
	400	}
28ff62b7 KM	401
	402	#ifdef OBJ
	403	/*
	404	* push a value onto the interpreter stack, longword aligned.
	405	*/
72fbef68 RT	406	struct nl
72fbef68 RT	407	*stackRV(p)
28ff62b7 KM	408	struct nl *p;
	409	{
	410	struct nl *q;
	411	int w, bn;
	412
	413	q = p->type;
72fbef68 RT	414	if (q == NLNIL)
72fbef68 RT	415	return (NLNIL);
28ff62b7 KM	416	bn = BLOCKNO(p->nl_block);
	417	w = width(q);
	418	switch (w) {
	419	case 8:
72fbef68	420	(void) put(2, O_RV8 \| bn << 8+INDX, (int)p->value[0]);
28ff62b7 KM	421	break;
28ff62b7 KM	422	case 4:
72fbef68	423	(void) put(2, O_RV4 \| bn << 8+INDX, (int)p->value[0]);
28ff62b7 KM	424	break;
28ff62b7 KM	425	case 2:
72fbef68	426	(void) put(2, O_RV24 \| bn << 8+INDX, (int)p->value[0]);
28ff62b7 KM	427	break;
28ff62b7 KM	428	case 1:
72fbef68	429	(void) put(2, O_RV14 \| bn << 8+INDX, (int)p->value[0]);
28ff62b7 KM	430	break;
28ff62b7 KM	431	default:
72fbef68	432	(void) put(3, O_RV \| bn << 8+INDX, (int)p->value[0], w);
28ff62b7 KM	433	break;
	434	}
	435	return (q);
	436	}
	437	#endif OBJ