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

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

static	char sccsid[] = "@(#)pcfunc.c 1.6 6/1/81";

#include "whoami.h"
#ifdef PC
    /*
     *	and to the end of the file
     */
#include "0.h"
#include "tree.h"
#include "opcode.h"
#include	"pc.h"
#include	"pcops.h"

/*
 * Funccod generates code for
 * built in function calls and calls
 * call to generate calls to user
 * defined functions and procedures.
 */
pcfunccod( r )
	int	 *r;
{
	struct nl *p;
	register struct nl *p1;
	register int *al;
	register op;
	int argc, *argv;
	int tr[2], tr2[4];
	char		*funcname;
	struct nl	*tempnlp;
	long		temptype;
	struct nl	*rettype;

	/*
	 * Verify that the given name
	 * is defined and the name of
	 * a function.
	 */
	p = lookup(r[2]);
	if (p == NIL) {
		rvlist(r[3]);
		return (NIL);
	}
	if (p->class != FUNC && p->class != FFUNC) {
		error("%s is not a function", p->symbol);
		rvlist(r[3]);
		return (NIL);
	}
	argv = r[3];
	/*
	 * Call handles user defined
	 * procedures and functions
	 */
	if (bn != 0)
		return (call(p, argv, FUNC, bn));
	/*
	 * Count the arguments
	 */
	argc = 0;
	for (al = argv; al != NIL; al = al[2])
		argc++;
	/*
	 * Built-in functions have
	 * their interpreter opcode
	 * associated with them.
	 */
	op = p->value[0] &~ NSTAND;
	if (opt('s') && (p->value[0] & NSTAND)) {
		standard();
		error("%s is a nonstandard function", p->symbol);
	}
	if ( op == O_ARGC ) {
	    putleaf( P2NAME , 0 , 0 , P2INT , "__argc" );
	    return nl + T4INT;
	}
	switch (op) {
		/*
		 * Parameterless functions
		 */
		case O_CLCK:
			funcname = "_CLCK";
			goto noargs;
		case O_SCLCK:
			funcname = "_SCLCK";
			goto noargs;
noargs:
			if (argc != 0) {
				error("%s takes no arguments", p->symbol);
				rvlist(argv);
				return (NIL);
			}
			putleaf( P2ICON , 0 , 0
				, ADDTYPE( P2FTN | P2INT , P2PTR )
				, funcname );
			putop( P2UNARY P2CALL , P2INT );
			return (nl+T4INT);
		case O_WCLCK:
			if (argc != 0) {
				error("%s takes no arguments", p->symbol);
				rvlist(argv);
				return (NIL);
			}
			putleaf( P2ICON , 0 , 0
				, ADDTYPE( P2FTN | P2INT , P2PTR )
				, "_time" );
			putleaf( P2ICON , 0 , 0 , P2INT , 0 );
			putop( P2CALL , P2INT );
			return (nl+T4INT);
		case O_EOF:
		case O_EOLN:
			if (argc == 0) {
				argv = tr;
				tr[1] = tr2;
				tr2[0] = T_VAR;
				tr2[2] = input->symbol;
				tr2[1] = tr2[3] = NIL;
				argc = 1;
			} else if (argc != 1) {
				error("%s takes either zero or one argument", p->symbol);
				rvlist(argv);
				return (NIL);
			}
		}
	/*
	 * All other functions take
	 * exactly one argument.
	 */
	if (argc != 1) {
		error("%s takes exactly one argument", p->symbol);
		rvlist(argv);
		return (NIL);
	}
	/*
	 * find out the type of the argument
	 */
	codeoff();
	p1 = stkrval((int *) argv[1], NLNIL , RREQ );
	codeon();
	if (p1 == NIL)
		return (NIL);
	/*
	 * figure out the return type and the funtion name
	 */
	switch (op) {
	    case O_EXP:
		    funcname = "_exp";
		    goto mathfunc;
	    case O_SIN:
		    funcname = "_sin";
		    goto mathfunc;
	    case O_COS:
		    funcname = "_cos";
		    goto mathfunc;
	    case O_ATAN:
		    funcname = "_atan";
		    goto mathfunc;
	    case O_LN:
		    funcname = opt('t') ? "_LN" : "_log";
		    goto mathfunc;
	    case O_SQRT:
		    funcname = opt('t') ? "_SQRT" : "_sqrt";
		    goto mathfunc;
	    case O_RANDOM:
		    funcname = "_RANDOM";
		    goto mathfunc;
mathfunc:
		    if (isnta(p1, "id")) {
			    error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
			    return (NIL);
		    }
		    putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2DOUBLE , P2PTR ) , funcname );
		    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
		    if ( isa( p1 , "i" ) ) {
			putop( P2SCONV , P2DOUBLE );
		    }
		    putop( P2CALL , P2DOUBLE );
		    return nl + TDOUBLE;
	    case O_EXPO:
		    if (isnta( p1 , "id" ) ) {
			    error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
			    return NIL;
		    }
		    putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_EXPO" );
		    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
		    if ( isa( p1 , "i" ) ) {
			putop( P2SCONV , P2DOUBLE );
		    }
		    putop( P2CALL , P2INT );
		    return ( nl + T4INT );
	    case O_UNDEF:
		    if ( isnta( p1 , "id" ) ) {
			    error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
			    return NIL;
		    }
		    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
		    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
		    putop( P2COMOP , P2INT );
		    return ( nl + TBOOL );
	    case O_SEED:
		    if (isnta(p1, "i")) {
			    error("seed's argument must be an integer, not %s", nameof(p1));
			    return (NIL);
		    }
		    putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_SEED" );
		    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
		    putop( P2CALL , P2INT );
		    return nl + T4INT;
	    case O_ROUND:
	    case O_TRUNC:
		    if ( isnta( p1 , "d" ) ) {
			    error("%s's argument must be a real, not %s", p->symbol, nameof(p1));
			    return (NIL);
		    }
		    putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR )
			    , op == O_ROUND ? "_ROUND" : "_TRUNC" );
		    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
		    putop( P2CALL , P2INT );
		    return nl + T4INT;
	    case O_ABS2:
			if ( isa( p1 , "d" ) ) {
			    putleaf( P2ICON , 0 , 0
				, ADDTYPE( P2FTN | P2DOUBLE , P2PTR )
				, "_fabs" );
			    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			    putop( P2CALL , P2DOUBLE );
			    return nl + TDOUBLE;
			}
			if ( isa( p1 , "i" ) ) {
			    putleaf( P2ICON , 0 , 0
				, ADDTYPE( P2FTN | P2INT , P2PTR ) , "_abs" );
			    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			    putop( P2CALL , P2INT );
			    return nl + T4INT;
			}
			error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1));
			return NIL;
	    case O_SQR2:
			if ( isa( p1 , "d" ) ) {
			    temptype = P2DOUBLE;
			    rettype = nl + TDOUBLE;
			    tempnlp = tmpalloc(sizeof(double), rettype, REGOK);
			} else if ( isa( p1 , "i" ) ) {
			    temptype = P2INT;
			    rettype = nl + T4INT;
			    tempnlp = tmpalloc(sizeof(long), rettype, REGOK);
			} else {
			    error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1));
			    return NIL;
			}
			putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
				tempnlp -> extra_flags , temptype , 0 );
			p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
			putop( P2ASSIGN , temptype );
			putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
				tempnlp -> extra_flags , temptype , 0 );
			putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
				tempnlp -> extra_flags , temptype , 0 );
			putop( P2MUL , temptype );
			putop( P2COMOP , temptype );
			return rettype;
	    case O_ORD2:
			p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			if (isa(p1, "bcis") || classify(p1) == TPTR) {
				return (nl+T4INT);
			}
			error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1));
			return (NIL);
	    case O_SUCC2:
	    case O_PRED2:
			if (isa(p1, "d")) {
				error("%s is forbidden for reals", p->symbol);
				return (NIL);
			}
			if ( isnta( p1 , "bcsi" ) ) {
			    error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1));
			    return NIL;
			}
			if ( opt( 't' ) ) {
			    putleaf( P2ICON , 0 , 0
				    , ADDTYPE( P2FTN | P2INT , P2PTR )
				    , op == O_SUCC2 ? "_SUCC" : "_PRED" );
			    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			    putleaf( P2ICON , p1 -> range[0] , 0 , P2INT , 0 );
			    putop( P2LISTOP , P2INT );
			    putleaf( P2ICON , p1 -> range[1] , 0 , P2INT , 0 );
			    putop( P2LISTOP , P2INT );
			    putop( P2CALL , P2INT );
			} else {
			    p1 = rvalue( argv[1] , NIL , RREQ );
			    putleaf( P2ICON , 1 , 0 , P2INT , 0 );
			    putop( op == O_SUCC2 ? P2PLUS : P2MINUS , P2INT );
			}
			if ( isa( p1 , "bcs" ) ) {
			    return p1;
			} else {
			    return nl + T4INT;
			}
	    case O_ODD2:
			if (isnta(p1, "i")) {
				error("odd's argument must be an integer, not %s", nameof(p1));
				return (NIL);
			}
			p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
			putleaf( P2ICON , 1 , 0 , P2INT , 0 );
			putop( P2AND , P2INT );
			return nl + TBOOL;
	    case O_CHR2:
			if (isnta(p1, "i")) {
				error("chr's argument must be an integer, not %s", nameof(p1));
				return (NIL);
			}
			if (opt('t')) {
			    putleaf( P2ICON , 0 , 0
				, ADDTYPE( P2FTN | P2CHAR , P2PTR ) , "_CHR" );
			    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			    putop( P2CALL , P2CHAR );
			} else {
			    p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
			}
			return nl + TCHAR;
	    case O_CARD:
			if (isnta(p1, "t")) {
			    error("Argument to card must be a set, not %s", nameof(p1));
			    return (NIL);
			}
			putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_CARD" );
			p1 = stkrval( (int *) argv[1] , NLNIL , LREQ );
			putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 );
			putop( P2LISTOP , P2INT );
			putop( P2CALL , P2INT );
			return nl + T2INT;
	    case O_EOLN:
			if (!text(p1)) {
				error("Argument to eoln must be a text file, not %s", nameof(p1));
				return (NIL);
			}
			putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOLN" );
			p1 = stklval( (int *) argv[1] , NOFLAGS );
			putop( P2CALL , P2INT );
			return nl + TBOOL;
	    case O_EOF:
			if (p1->class != FILET) {
				error("Argument to eof must be file, not %s", nameof(p1));
				return (NIL);
			}
			putleaf( P2ICON , 0 , 0
			    , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_TEOF" );
			p1 = stklval( (int *) argv[1] , NOFLAGS );
			putop( P2CALL , P2INT );
			return nl + TBOOL;
	    case 0:
			error("%s is an unimplemented 6000-3.4 extension", p->symbol);
	    default:
			panic("func1");
	}
}
#endif PC
Commit	Line	Data
3964952e PK	1	/* Copyright (c) 1979 Regents of the University of California */
3964952e PK	2
4b9ccde7	3	static char sccsid[] = "@(#)pcfunc.c 1.6 6/1/81";
3964952e PK	4
	5	#include "whoami.h"
	6	#ifdef PC
	7	/*
	8	* and to the end of the file
	9	*/
	10	#include "0.h"
	11	#include "tree.h"
	12	#include "opcode.h"
	13	#include "pc.h"
	14	#include "pcops.h"
	15
3964952e PK	16	/*
	17	* Funccod generates code for
	18	* built in function calls and calls
	19	* call to generate calls to user
	20	* defined functions and procedures.
	21	*/
	22	pcfunccod( r )
	23	int *r;
	24	{
	25	struct nl *p;
	26	register struct nl *p1;
	27	register int *al;
	28	register op;
	29	int argc, *argv;
	30	int tr[2], tr2[4];
	31	char *funcname;
1f43951f	32	struct nl *tempnlp;
3964952e PK	33	long temptype;
	34	struct nl *rettype;
	35
	36	/*
	37	* Verify that the given name
	38	* is defined and the name of
	39	* a function.
	40	*/
	41	p = lookup(r[2]);
	42	if (p == NIL) {
	43	rvlist(r[3]);
	44	return (NIL);
	45	}
c4e911b6	46	if (p->class != FUNC && p->class != FFUNC) {
3964952e PK	47	error("%s is not a function", p->symbol);
	48	rvlist(r[3]);
	49	return (NIL);
	50	}
	51	argv = r[3];
	52	/*
	53	* Call handles user defined
	54	* procedures and functions
	55	*/
	56	if (bn != 0)
	57	return (call(p, argv, FUNC, bn));
	58	/*
	59	* Count the arguments
	60	*/
	61	argc = 0;
	62	for (al = argv; al != NIL; al = al[2])
	63	argc++;
	64	/*
	65	* Built-in functions have
	66	* their interpreter opcode
	67	* associated with them.
	68	*/
	69	op = p->value[0] &~ NSTAND;
	70	if (opt('s') && (p->value[0] & NSTAND)) {
	71	standard();
	72	error("%s is a nonstandard function", p->symbol);
	73	}
	74	if ( op == O_ARGC ) {
	75	putleaf( P2NAME , 0 , 0 , P2INT , "__argc" );
	76	return nl + T4INT;
	77	}
	78	switch (op) {
	79	/*
	80	* Parameterless functions
	81	*/
	82	case O_CLCK:
	83	funcname = "_CLCK";
	84	goto noargs;
	85	case O_SCLCK:
	86	funcname = "_SCLCK";
	87	goto noargs;
	88	noargs:
	89	if (argc != 0) {
	90	error("%s takes no arguments", p->symbol);
	91	rvlist(argv);
	92	return (NIL);
	93	}
	94	putleaf( P2ICON , 0 , 0
	95	, ADDTYPE( P2FTN \| P2INT , P2PTR )
	96	, funcname );
	97	putop( P2UNARY P2CALL , P2INT );
	98	return (nl+T4INT);
	99	case O_WCLCK:
	100	if (argc != 0) {
	101	error("%s takes no arguments", p->symbol);
	102	rvlist(argv);
	103	return (NIL);
	104	}
	105	putleaf( P2ICON , 0 , 0
	106	, ADDTYPE( P2FTN \| P2INT , P2PTR )
	107	, "_time" );
	108	putleaf( P2ICON , 0 , 0 , P2INT , 0 );
	109	putop( P2CALL , P2INT );
	110	return (nl+T4INT);
111	case O_EOF:
112	case O_EOLN:
113	if (argc == 0) {
114	argv = tr;
115	tr[1] = tr2;
116	tr2[0] = T_VAR;
117	tr2[2] = input->symbol;
118	tr2[1] = tr2[3] = NIL;
119	argc = 1;
120	} else if (argc != 1) {
121	error("%s takes either zero or one argument", p->symbol);
122	rvlist(argv);
123	return (NIL);
124	}
125	}
126	/*
127	* All other functions take
128	* exactly one argument.
129	*/
130	if (argc != 1) {
131	error("%s takes exactly one argument", p->symbol);
132	rvlist(argv);
133	return (NIL);
134	}
135	/*
136	* find out the type of the argument
137	*/
138	codeoff();
139	p1 = stkrval((int *) argv[1], NLNIL , RREQ );
140	codeon();
141	if (p1 == NIL)
142	return (NIL);
143	/*
144	* figure out the return type and the funtion name
145	*/
146	switch (op) {
147	case O_EXP:
148	funcname = "_exp";
149	goto mathfunc;
150	case O_SIN:
151	funcname = "_sin";
152	goto mathfunc;
153	case O_COS:
154	funcname = "_cos";
155	goto mathfunc;
156	case O_ATAN:
157	funcname = "_atan";
158	goto mathfunc;
159	case O_LN:
160	funcname = opt('t') ? "_LN" : "_log";
161	goto mathfunc;
162	case O_SQRT:
163	funcname = opt('t') ? "_SQRT" : "_sqrt";
164	goto mathfunc;
165	case O_RANDOM:
166	funcname = "_RANDOM";
167	goto mathfunc;
168	mathfunc:
169	if (isnta(p1, "id")) {
170	error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
171	return (NIL);
172	}
173	putleaf( P2ICON , 0 , 0
174	, ADDTYPE( P2FTN \| P2DOUBLE , P2PTR ) , funcname );
175	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
176	if ( isa( p1 , "i" ) ) {
177	putop( P2SCONV , P2DOUBLE );
178	}
179	putop( P2CALL , P2DOUBLE );
180	return nl + TDOUBLE;
181	case O_EXPO:
182	if (isnta( p1 , "id" ) ) {
183	error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
184	return NIL;
185	}
186	putleaf( P2ICON , 0 , 0
187	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_EXPO" );
188	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
189	if ( isa( p1 , "i" ) ) {
190	putop( P2SCONV , P2DOUBLE );
191	}
192	putop( P2CALL , P2INT );
193	return ( nl + T4INT );
194	case O_UNDEF:
195	if ( isnta( p1 , "id" ) ) {
196	error("%s's argument must be integer or real, not %s", p->symbol, nameof(p1));
197	return NIL;
198	}
199	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
200	putleaf( P2ICON , 0 , 0 , P2INT , 0 );
201	putop( P2COMOP , P2INT );
202	return ( nl + TBOOL );
203	case O_SEED:
204	if (isnta(p1, "i")) {
205	error("seed's argument must be an integer, not %s", nameof(p1));
206	return (NIL);
207	}
208	putleaf( P2ICON , 0 , 0
209	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_SEED" );
210	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
211	putop( P2CALL , P2INT );
212	return nl + T4INT;
213	case O_ROUND:
214	case O_TRUNC:
215	if ( isnta( p1 , "d" ) ) {
216	error("%s's argument must be a real, not %s", p->symbol, nameof(p1));
217	return (NIL);
218	}
219	putleaf( P2ICON , 0 , 0
220	, ADDTYPE( P2FTN \| P2INT , P2PTR )
221	, op == O_ROUND ? "_ROUND" : "_TRUNC" );
222	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
223	putop( P2CALL , P2INT );
224	return nl + T4INT;
225	case O_ABS2:
226	if ( isa( p1 , "d" ) ) {
227	putleaf( P2ICON , 0 , 0
228	, ADDTYPE( P2FTN \| P2DOUBLE , P2PTR )
229	, "_fabs" );
230	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
231	putop( P2CALL , P2DOUBLE );
232	return nl + TDOUBLE;
233	}
234	if ( isa( p1 , "i" ) ) {
235	putleaf( P2ICON , 0 , 0
236	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_abs" );
237	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
238	putop( P2CALL , P2INT );
239	return nl + T4INT;
240	}
241	error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1));
242	return NIL;
243	case O_SQR2:
244	if ( isa( p1 , "d" ) ) {
245	temptype = P2DOUBLE;
246	rettype = nl + TDOUBLE;
1f43951f	247	tempnlp = tmpalloc(sizeof(double), rettype, REGOK);
3964952e PK	248	} else if ( isa( p1 , "i" ) ) {
	249	temptype = P2INT;
	250	rettype = nl + T4INT;
1f43951f	251	tempnlp = tmpalloc(sizeof(long), rettype, REGOK);
3964952e PK	252	} else {
	253	error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1));
	254	return NIL;
	255	}
1f43951f PK	256	putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
1f43951f PK	257	tempnlp -> extra_flags , temptype , 0 );
3964952e PK	258	p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
3964952e PK	259	putop( P2ASSIGN , temptype );
1f43951f PK	260	putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
	261	tempnlp -> extra_flags , temptype , 0 );
	262	putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
	263	tempnlp -> extra_flags , temptype , 0 );
3964952e PK	264	putop( P2MUL , temptype );
	265	putop( P2COMOP , temptype );
	266	return rettype;
	267	case O_ORD2:
	268	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
	269	if (isa(p1, "bcis") \|\| classify(p1) == TPTR) {
	270	return (nl+T4INT);
	271	}
	272	error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1));
	273	return (NIL);
	274	case O_SUCC2:
	275	case O_PRED2:
	276	if (isa(p1, "d")) {
	277	error("%s is forbidden for reals", p->symbol);
	278	return (NIL);
	279	}
	280	if ( isnta( p1 , "bcsi" ) ) {
	281	error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1));
	282	return NIL;
	283	}
	284	if ( opt( 't' ) ) {
	285	putleaf( P2ICON , 0 , 0
	286	, ADDTYPE( P2FTN \| P2INT , P2PTR )
	287	, op == O_SUCC2 ? "_SUCC" : "_PRED" );
	288	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
	289	putleaf( P2ICON , p1 -> range[0] , 0 , P2INT , 0 );
	290	putop( P2LISTOP , P2INT );
	291	putleaf( P2ICON , p1 -> range[1] , 0 , P2INT , 0 );
	292	putop( P2LISTOP , P2INT );
	293	putop( P2CALL , P2INT );
	294	} else {
	295	p1 = rvalue( argv[1] , NIL , RREQ );
	296	putleaf( P2ICON , 1 , 0 , P2INT , 0 );
	297	putop( op == O_SUCC2 ? P2PLUS : P2MINUS , P2INT );
	298	}
	299	if ( isa( p1 , "bcs" ) ) {
	300	return p1;
	301	} else {
	302	return nl + T4INT;
	303	}
	304	case O_ODD2:
	305	if (isnta(p1, "i")) {
	306	error("odd's argument must be an integer, not %s", nameof(p1));
	307	return (NIL);
	308	}
	309	p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
	310	putleaf( P2ICON , 1 , 0 , P2INT , 0 );
	311	putop( P2AND , P2INT );
	312	return nl + TBOOL;
	313	case O_CHR2:
	314	if (isnta(p1, "i")) {
	315	error("chr's argument must be an integer, not %s", nameof(p1));
	316	return (NIL);
	317	}
	318	if (opt('t')) {
	319	putleaf( P2ICON , 0 , 0
	320	, ADDTYPE( P2FTN \| P2CHAR , P2PTR ) , "_CHR" );
	321	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
	322	putop( P2CALL , P2CHAR );
	323	} else {
	324	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
	325	}
	326	return nl + TCHAR;
	327	case O_CARD:
70de7f21 PK	328	if (isnta(p1, "t")) {
	329	error("Argument to card must be a set, not %s", nameof(p1));
	330	return (NIL);
3964952e	331	}
70de7f21 PK	332	putleaf( P2ICON , 0 , 0
	333	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_CARD" );
	334	p1 = stkrval( (int *) argv[1] , NLNIL , LREQ );
	335	putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 );
	336	putop( P2LISTOP , P2INT );
	337	putop( P2CALL , P2INT );
3964952e PK	338	return nl + T2INT;
	339	case O_EOLN:
	340	if (!text(p1)) {
	341	error("Argument to eoln must be a text file, not %s", nameof(p1));
	342	return (NIL);
	343	}
	344	putleaf( P2ICON , 0 , 0
	345	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_TEOLN" );
	346	p1 = stklval( (int *) argv[1] , NOFLAGS );
	347	putop( P2CALL , P2INT );
	348	return nl + TBOOL;
	349	case O_EOF:
	350	if (p1->class != FILET) {
	351	error("Argument to eof must be file, not %s", nameof(p1));
	352	return (NIL);
	353	}
	354	putleaf( P2ICON , 0 , 0
	355	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_TEOF" );
	356	p1 = stklval( (int *) argv[1] , NOFLAGS );
	357	putop( P2CALL , P2INT );
	358	return nl + TBOOL;
	359	case 0:
	360	error("%s is an unimplemented 6000-3.4 extension", p->symbol);
	361	default:
	362	panic("func1");
	363	}
	364	}
	365	#endif PC