[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.3 %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"

/*
 * 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 (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
70de7f21	3	static char sccsid[] = "@(#)pcfunc.c 1.3 %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
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;
	32	long tempoff;
	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;
247	sizes[ cbn ].om_off -= sizeof( double );
248	} else if ( isa( p1 , "i" ) ) {
249	temptype = P2INT;
250	rettype = nl + T4INT;
251	sizes[ cbn ].om_off -= sizeof( long );
252	} else {
253	error("%s's argument must be an integer or real, not %s", p->symbol, nameof(p1));
254	return NIL;
255	}
256	tempoff = sizes[ cbn ].om_off;
257	if ( tempoff < sizes[ cbn ].om_max ) {
258	sizes[ cbn ].om_max = tempoff;
259	}
260	putlbracket( ftnno , -tempoff );
261	putRV( 0 , cbn , tempoff , temptype , 0 );
262	p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
263	putop( P2ASSIGN , temptype );
264	putRV( 0 , cbn , tempoff , temptype , 0 );
265	putRV( 0 , cbn , tempoff , temptype , 0 );
266	putop( P2MUL , temptype );
267	putop( P2COMOP , temptype );
268	return rettype;
269	case O_ORD2:
270	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
271	if (isa(p1, "bcis") \|\| classify(p1) == TPTR) {
272	return (nl+T4INT);
273	}
274	error("ord's argument must be of scalar type or a pointer, not %s", nameof(p1));
275	return (NIL);
276	case O_SUCC2:
277	case O_PRED2:
278	if (isa(p1, "d")) {
279	error("%s is forbidden for reals", p->symbol);
280	return (NIL);
281	}
282	if ( isnta( p1 , "bcsi" ) ) {
283	error("%s's argument must be of scalar type, not %s", p->symbol, nameof(p1));
284	return NIL;
285	}
286	if ( opt( 't' ) ) {
287	putleaf( P2ICON , 0 , 0
288	, ADDTYPE( P2FTN \| P2INT , P2PTR )
289	, op == O_SUCC2 ? "_SUCC" : "_PRED" );
290	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
291	putleaf( P2ICON , p1 -> range[0] , 0 , P2INT , 0 );
292	putop( P2LISTOP , P2INT );
293	putleaf( P2ICON , p1 -> range[1] , 0 , P2INT , 0 );
294	putop( P2LISTOP , P2INT );
295	putop( P2CALL , P2INT );
296	} else {
297	p1 = rvalue( argv[1] , NIL , RREQ );
298	putleaf( P2ICON , 1 , 0 , P2INT , 0 );
299	putop( op == O_SUCC2 ? P2PLUS : P2MINUS , P2INT );
300	}
301	if ( isa( p1 , "bcs" ) ) {
302	return p1;
303	} else {
304	return nl + T4INT;
305	}
306	case O_ODD2:
307	if (isnta(p1, "i")) {
308	error("odd's argument must be an integer, not %s", nameof(p1));
309	return (NIL);
310	}
311	p1 = rvalue( (int *) argv[1] , NLNIL , RREQ );
312	putleaf( P2ICON , 1 , 0 , P2INT , 0 );
313	putop( P2AND , P2INT );
314	return nl + TBOOL;
315	case O_CHR2:
316	if (isnta(p1, "i")) {
317	error("chr's argument must be an integer, not %s", nameof(p1));
318	return (NIL);
319	}
320	if (opt('t')) {
321	putleaf( P2ICON , 0 , 0
322	, ADDTYPE( P2FTN \| P2CHAR , P2PTR ) , "_CHR" );
323	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
324	putop( P2CALL , P2CHAR );
325	} else {
326	p1 = stkrval( (int *) argv[1] , NLNIL , RREQ );
327	}
328	return nl + TCHAR;
329	case O_CARD:
70de7f21 PK	330	if (isnta(p1, "t")) {
	331	error("Argument to card must be a set, not %s", nameof(p1));
	332	return (NIL);
3964952e	333	}
70de7f21 PK	334	putleaf( P2ICON , 0 , 0
	335	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_CARD" );
	336	p1 = stkrval( (int *) argv[1] , NLNIL , LREQ );
	337	putleaf( P2ICON , lwidth( p1 ) , 0 , P2INT , 0 );
	338	putop( P2LISTOP , P2INT );
	339	putop( P2CALL , P2INT );
3964952e PK	340	return nl + T2INT;
	341	case O_EOLN:
	342	if (!text(p1)) {
	343	error("Argument to eoln must be a text file, not %s", nameof(p1));
	344	return (NIL);
	345	}
	346	putleaf( P2ICON , 0 , 0
	347	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_TEOLN" );
	348	p1 = stklval( (int *) argv[1] , NOFLAGS );
	349	putop( P2CALL , P2INT );
	350	return nl + TBOOL;
	351	case O_EOF:
	352	if (p1->class != FILET) {
	353	error("Argument to eof must be file, not %s", nameof(p1));
	354	return (NIL);
	355	}
	356	putleaf( P2ICON , 0 , 0
	357	, ADDTYPE( P2FTN \| P2INT , P2PTR ) , "_TEOF" );
	358	p1 = stklval( (int *) argv[1] , NOFLAGS );
	359	putop( P2CALL , P2INT );
	360	return nl + TBOOL;
	361	case 0:
	362	error("%s is an unimplemented 6000-3.4 extension", p->symbol);
	363	default:
	364	panic("func1");
	365	}
	366	}
	367	#endif PC