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

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

static	char sccsid[] = "@(#)pcfunc.c 1.2 %G%";

#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"

bool cardempty = FALSE;

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