xref: /original-bsd/usr.bin/pascal/src/call.c (revision f052b07a) 
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  */
6 
7 #ifndef lint
8 static char sccsid[] = "@(#)call.c	5.3 (Berkeley) 11/12/86";
9 #endif not lint
10 
11 #include "whoami.h"
12 #include "0.h"
13 #include "tree.h"
14 #include "opcode.h"
15 #include "objfmt.h"
16 #include "align.h"
17 #ifdef PC
18 #   include "pc.h"
19 #   include <pcc.h>
20 #endif PC
21 #include "tmps.h"
22 #include "tree_ty.h"
23 
24 /*
25  * Call generates code for calls to
26  * user defined procedures and functions
27  * and is called by proc and funccod.
28  * P is the result of the lookup
29  * of the procedure/function symbol,
30  * and porf is PROC or FUNC.
31  * Psbn is the block number of p.
32  *
33  *	the idea here is that regular scalar functions are just called,
34  *	while structure functions and formal functions have their results
35  *	stored in a temporary after the call.
36  *	structure functions do this because they return pointers
37  *	to static results, so we copy the static
38  *	and return a pointer to the copy.
39  *	formal functions do this because we have to save the result
40  *	around a call to the runtime routine which restores the display,
41  *	so we can't just leave the result lying around in registers.
42  *	formal calls save the address of the descriptor in a local
43  *	temporary, so it can be addressed for the call which restores
44  *	the display (FRTN).
45  *	calls to formal parameters pass the formal as a hidden argument
46  *	to a special entry point for the formal call.
47  *	[this is somewhat dependent on the way arguments are addressed.]
48  *	so PROCs and scalar FUNCs look like
49  *		p(...args...)
50  *	structure FUNCs look like
51  *		(temp = p(...args...),&temp)
52  *	formal FPROCs look like
53  *		( t=p,( t -> entryaddr )(...args...,t,s),FRTN(t,s))
54  *	formal scalar FFUNCs look like
55  *		( t=p,temp=( t -> entryaddr )(...args...,t,s),FRTN(t,s),temp)
56  *	formal structure FFUNCs look like
57  *		(t=p,temp = ( t -> entryaddr )(...args...,t,s),FRTN(t,s),&temp)
58  */
59 struct nl *
60 call(p, argv_node, porf, psbn)
61 	struct nl *p;
62 	struct tnode	*argv_node;	/* list node */
63 	int porf, psbn;
64 {
65 	register struct nl *p1, *q, *p2;
66 	register struct nl *ptype, *ctype;
67 	struct tnode *rnode;
68 	int i, j, d;
69 	bool chk = TRUE;
70  	struct nl	*savedispnp;	/* temporary to hold saved display */
71 #	ifdef PC
72 	    int		p_type_class = classify( p -> type );
73 	    long	p_type_p2type = p2type( p -> type );
74 	    bool	noarguments;
75 		/*
76 		 *	these get used if temporaries and structures are used
77 		 */
78 	    struct nl	*tempnlp;
79 	    long	temptype;	/* type of the temporary */
80 	    long	p_type_width;
81 	    long	p_type_align;
82 	    char	extname[ BUFSIZ ];
83 	    struct nl	*tempdescrp;
84 #	endif PC
85 
86          if (p->class == FFUNC || p->class == FPROC) {
87  	    /*
88  	     * allocate space to save the display for formal calls
89  	     */
90 	    savedispnp = tmpalloc( (long) sizeof display , NLNIL , NOREG );
91  	}
92 #	ifdef OBJ
93 	    if (p->class == FFUNC || p->class == FPROC) {
94  		(void) put(2, O_LV | cbn << 8 + INDX ,
95  			(int) savedispnp -> value[ NL_OFFS ] );
96 		(void) put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
97 	    }
98 	    if (porf == FUNC) {
99 		    /*
100 		     * Push some space
101 		     * for the function return type
102 		     */
103 		    (void) put(2, O_PUSH,
104 			-roundup(lwidth(p->type), (long) A_STACK));
105 	    }
106 #	endif OBJ
107 #	ifdef PC
108 		/*
109 		 *	if this is a formal call,
110 		 *	stash the address of the descriptor
111 		 *	in a temporary so we can find it
112 		 *	after the FCALL for the call to FRTN
113 		 */
114 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
115 		tempdescrp = tmpalloc((long) (sizeof( struct formalrtn *)),
116 					NLNIL, REGOK );
117 		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
118 			tempdescrp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
119 		putRV((char *) 0 , psbn , p -> value[ NL_OFFS ] ,
120 			p -> extra_flags , PCCTM_PTR|PCCT_STRTY );
121 		putop( PCC_ASSIGN , PCCTM_PTR | PCCT_STRTY );
122 	    }
123 		/*
124 		 *	if we have to store a temporary,
125 		 *	temptype will be its type,
126 		 *	otherwise, it's PCCT_UNDEF.
127 		 */
128 	    temptype = PCCT_UNDEF;
129 	    if ( porf == FUNC ) {
130 		p_type_width = width( p -> type );
131 		switch( p_type_class ) {
132 		    case TSTR:
133 		    case TSET:
134 		    case TREC:
135 		    case TFILE:
136 		    case TARY:
137 			temptype = PCCT_STRTY;
138 			p_type_align = align( p -> type );
139 			break;
140 		    default:
141 			if ( p -> class == FFUNC ) {
142 			    temptype = p2type( p -> type );
143 			}
144 			break;
145 		}
146 		if ( temptype != PCCT_UNDEF ) {
147 		    tempnlp = tmpalloc(p_type_width, p -> type, NOREG);
148 			/*
149 			 *	temp
150 			 *	for (temp = ...
151 			 */
152 		    putRV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
153 			    tempnlp -> extra_flags , (int) temptype );
154 		}
155 	    }
156 	    switch ( p -> class ) {
157 		case FUNC:
158 		case PROC:
159 			/*
160 			 *	... p( ...
161 			 */
162 		    sextname( extname , p -> symbol , BLOCKNO(p -> nl_block) );
163 		    putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
164 		    break;
165 		case FFUNC:
166 		case FPROC:
167 
168 			    /*
169 			     *	... ( t -> entryaddr )( ...
170 			     */
171 			    /* 	the descriptor */
172 			putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
173 				tempdescrp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
174 			    /*	the entry address within the descriptor */
175 			if ( FENTRYOFFSET != 0 ) {
176 			    putleaf( PCC_ICON , FENTRYOFFSET , 0 , PCCT_INT ,
177 						(char *) 0 );
178 			    putop( PCC_PLUS ,
179 				PCCM_ADDTYPE(
180 				    PCCM_ADDTYPE( PCCM_ADDTYPE( p2type( p ) , PCCTM_FTN ) ,
181 					    PCCTM_PTR ) ,
182 					PCCTM_PTR ) );
183 			}
184 			    /*
185 			     *	indirect to fetch the formal entry address
186 			     *	with the result type of the routine.
187 			     */
188 			if (p -> class == FFUNC) {
189 			    putop( PCCOM_UNARY PCC_MUL ,
190 				PCCM_ADDTYPE(PCCM_ADDTYPE(p2type(p -> type), PCCTM_FTN),
191 					PCCTM_PTR));
192 			} else {
193 				/* procedures are int returning functions */
194 			    putop( PCCOM_UNARY PCC_MUL ,
195 				PCCM_ADDTYPE(PCCM_ADDTYPE(PCCT_INT, PCCTM_FTN), PCCTM_PTR));
196 			}
197 			break;
198 		default:
199 			panic("call class");
200 	    }
201 	    noarguments = TRUE;
202 #	endif PC
203 	/*
204 	 * Loop and process each of
205 	 * arguments to the proc/func.
206 	 *	... ( ... args ... ) ...
207 	 */
208 	ptype = NIL;
209 	for (p1 = plist(p); p1 != NLNIL; p1 = p1->chain) {
210 	    if (argv_node == TR_NIL) {
211 		    error("Not enough arguments to %s", p->symbol);
212 		    return (NLNIL);
213 	    }
214 	    switch (p1->class) {
215 		case REF:
216 			/*
217 			 * Var parameter
218 			 */
219 			rnode = argv_node->list_node.list;
220 			if (rnode != TR_NIL && rnode->tag != T_VAR) {
221 				error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
222 				chk = FALSE;
223 				break;
224 			}
225 			q = lvalue( argv_node->list_node.list,
226 					MOD | ASGN , LREQ );
227 			if (q == NIL) {
228 				chk = FALSE;
229 				break;
230 			}
231 			p2 = p1->type;
232 			if (p2 == NLNIL || p2->chain == NLNIL || p2->chain->class != CRANGE) {
233 			    if (q != p2) {
234 				error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
235 				chk = FALSE;
236 			    }
237 			    break;
238 			} else {
239 			    /* conformant array */
240 			    if (p1 == ptype) {
241 				if (q != ctype) {
242 				    error("Conformant array parameters in the same specification must be the same type.");
243 				    goto conf_err;
244 				}
245 			    } else {
246 				if (classify(q) != TARY && classify(q) != TSTR) {
247 				    error("Array type required for var parameter %s of %s",p1->symbol,p->symbol);
248 				    goto conf_err;
249 				}
250 				/* check base type of array */
251 				if (p2->type != q->type) {
252 				    error("Base type of array not identical to that of conformant array parameter %s of %s", p1->symbol, p->symbol);
253 				    goto conf_err;
254 				}
255 				if (p2->value[0] != q->value[0]) {
256 				    error("Subscript number mismatch on conformant array parameter %s of %s", p1->symbol, p->symbol);
257 				    /* Don't process array bounds & width */
258 conf_err:			    if (p1->chain->type->class == CRANGE) {
259 					d = p1->value[0];
260 					for (i = 1; i <= d; i++) {
261 					    /* for each subscript, pass by
262 					     * bounds and width
263 					     */
264 					    p1 = p1->chain->chain->chain;
265 					}
266 				    }
267 				    ptype = ctype = NLNIL;
268 				    chk = FALSE;
269 				    break;
270 				}
271 				/*
272 				 * Save array type for all parameters with same
273 				 * specification.
274 				 */
275 				ctype = q;
276 				ptype = p2;
277 				/*
278 				 * If at end of conformant array list,
279 				 * get bounds.
280 				 */
281 				if (p1->chain->type->class == CRANGE) {
282 				    /* check each subscript, put on stack */
283 				    d = ptype->value[0];
284 				    q = ctype;
285 				    for (i = 1; i <= d; i++) {
286 					p1 = p1->chain;
287 					q = q->chain;
288 					if (incompat(q, p1->type, TR_NIL)){
289 					    error("Subscript type not conformable with parameter %s of %s", p1->symbol, p->symbol);
290 					    chk = FALSE;
291 					    break;
292 					}
293 					/* Put lower and upper bound & width */
294 #					ifdef OBJ
295 					if (q->type->class == CRANGE) {
296 					    putcbnds(q->type);
297 					} else {
298 					    put(2, width(p1->type) <= 2 ? O_CON2
299 						: O_CON4, q->range[0]);
300 					    put(2, width(p1->type) <= 2 ? O_CON2
301 						: O_CON4, q->range[1]);
302 					    put(2, width(p1->type) <= 2 ? O_CON2
303 						: O_CON4, aryconst(ctype,i));
304 					}
305 #					endif OBJ
306 #					ifdef PC
307 					if (q->type->class == CRANGE) {
308 					    for (j = 1; j <= 3; j++) {
309 						p2 = p->nptr[j];
310 						putRV(p2->symbol, (p2->nl_block
311 						    & 037), p2->value[0],
312 						    p2->extra_flags,p2type(p2));
313 						putop(PCC_CM, PCCT_INT);
314 					    }
315 					} else {
316 					    putleaf(PCC_ICON, q->range[0], 0,PCCT_INT,0);
317 					    putop( PCC_CM , PCCT_INT );
318 					    putleaf(PCC_ICON, q->range[1], 0,PCCT_INT,0);
319 					    putop( PCC_CM , PCCT_INT );
320 					    putleaf(PCC_ICON,aryconst(ctype,i),0,PCCT_INT,0);
321 					    putop( PCC_CM , PCCT_INT );
322 					}
323 #					endif PC
324 					p1 = p1->chain->chain;
325 				    }
326 				}
327 			    }
328 			}
329 			break;
330 		case VAR:
331 			/*
332 			 * Value parameter
333 			 */
334 #			ifdef OBJ
335 			    q = rvalue(argv_node->list_node.list,
336 					p1->type , RREQ );
337 #			endif OBJ
338 #			ifdef PC
339 				/*
340 				 * structure arguments require lvalues,
341 				 * scalars use rvalue.
342 				 */
343 			    switch( classify( p1 -> type ) ) {
344 				case TFILE:
345 				case TARY:
346 				case TREC:
347 				case TSET:
348 				case TSTR:
349 				q = stkrval(argv_node->list_node.list,
350 						p1 -> type , (long) LREQ );
351 				    break;
352 				case TINT:
353 				case TSCAL:
354 				case TBOOL:
355 				case TCHAR:
356 				    precheck( p1 -> type , "_RANG4" , "_RSNG4" );
357 				q = stkrval(argv_node->list_node.list,
358 						p1 -> type , (long) RREQ );
359 				    postcheck(p1 -> type, nl+T4INT);
360 				    break;
361 				case TDOUBLE:
362 				q = stkrval(argv_node->list_node.list,
363 						p1 -> type , (long) RREQ );
364 				    sconv(p2type(q), PCCT_DOUBLE);
365 				    break;
366 				default:
367 				    q = rvalue(argv_node->list_node.list,
368 						p1 -> type , RREQ );
369 				    break;
370 			    }
371 #			endif PC
372 			if (q == NIL) {
373 				chk = FALSE;
374 				break;
375 			}
376 			if (incompat(q, p1->type,
377 				argv_node->list_node.list)) {
378 				cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
379 				chk = FALSE;
380 				break;
381 			}
382 #			ifdef OBJ
383 			    if (isa(p1->type, "bcsi"))
384 				    rangechk(p1->type, q);
385 			    if (q->class != STR)
386 				    convert(q, p1->type);
387 #			endif OBJ
388 #			ifdef PC
389 			    switch( classify( p1 -> type ) ) {
390 				case TFILE:
391 				case TARY:
392 				case TREC:
393 				case TSET:
394 				case TSTR:
395 					putstrop( PCC_STARG
396 					    , p2type( p1 -> type )
397 					    , (int) lwidth( p1 -> type )
398 					    , align( p1 -> type ) );
399 			    }
400 #			endif PC
401 			break;
402 		case FFUNC:
403 			/*
404 			 * function parameter
405 			 */
406 			q = flvalue(argv_node->list_node.list, p1 );
407 			/*chk = (chk && fcompat(q, p1));*/
408 			if ((chk) && (fcompat(q, p1)))
409 			    chk = TRUE;
410 			else
411 			    chk = FALSE;
412 			break;
413 		case FPROC:
414 			/*
415 			 * procedure parameter
416 			 */
417 			q = flvalue(argv_node->list_node.list, p1 );
418 			/* chk = (chk && fcompat(q, p1)); */
419 			if ((chk) && (fcompat(q, p1)))
420 			    chk = TRUE;
421 			else chk = FALSE;
422 			break;
423 		default:
424 			panic("call");
425 	    }
426 #	    ifdef PC
427 		    /*
428 		     *	if this is the nth (>1) argument,
429 		     *	hang it on the left linear list of arguments
430 		     */
431 		if ( noarguments ) {
432 			noarguments = FALSE;
433 		} else {
434 			putop( PCC_CM , PCCT_INT );
435 		}
436 #	    endif PC
437 	    argv_node = argv_node->list_node.next;
438 	}
439 	if (argv_node != TR_NIL) {
440 		error("Too many arguments to %s", p->symbol);
441 		rvlist(argv_node);
442 		return (NLNIL);
443 	}
444 	if (chk == FALSE)
445 		return NLNIL;
446 #	ifdef OBJ
447 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
448 		(void) put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]);
449  		(void) put(2, O_LV | cbn << 8 + INDX ,
450  			(int) savedispnp -> value[ NL_OFFS ] );
451 		(void) put(1, O_FCALL);
452 		(void) put(2, O_FRTN, roundup(width(p->type), (long) A_STACK));
453 	    } else {
454 		(void) put(2, O_CALL | psbn << 8, (long)p->value[NL_ENTLOC]);
455 	    }
456 #	endif OBJ
457 #	ifdef PC
458 		/*
459 		 *	for formal calls: add the hidden argument
460 		 *	which is the formal struct describing the
461 		 *	environment of the routine.
462 		 *	and the argument which is the address of the
463 		 *	space into which to save the display.
464 		 */
465 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
466 		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
467 			tempdescrp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
468 		if ( !noarguments ) {
469 		    putop( PCC_CM , PCCT_INT );
470 		}
471 		noarguments = FALSE;
472  		putLV((char *) 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
473  			savedispnp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
474  		putop( PCC_CM , PCCT_INT );
475 	    }
476 		/*
477 		 *	do the actual call:
478 		 *	    either	... p( ... ) ...
479 		 *	    or		... ( t -> entryaddr )( ... ) ...
480 		 *	and maybe an assignment.
481 		 */
482 	    if ( porf == FUNC ) {
483 		switch ( p_type_class ) {
484 		    case TBOOL:
485 		    case TCHAR:
486 		    case TINT:
487 		    case TSCAL:
488 		    case TDOUBLE:
489 		    case TPTR:
490 			putop( ( noarguments ? PCCOM_UNARY PCC_CALL : PCC_CALL ) ,
491 				(int) p_type_p2type );
492 			if ( p -> class == FFUNC ) {
493 			    putop( PCC_ASSIGN , (int) p_type_p2type );
494 			}
495 			break;
496 		    default:
497 			putstrop( ( noarguments ? PCCOM_UNARY PCC_STCALL : PCC_STCALL ),
498 				(int) PCCM_ADDTYPE( p_type_p2type , PCCTM_PTR ) ,
499 				(int) p_type_width ,(int) p_type_align );
500 			putstrop(PCC_STASG, (int) PCCM_ADDTYPE(p_type_p2type, PCCTM_PTR),
501 				(int) lwidth(p -> type), align(p -> type));
502 			break;
503 		}
504 	    } else {
505 		putop( ( noarguments ? PCCOM_UNARY PCC_CALL : PCC_CALL ) , PCCT_INT );
506 	    }
507 		/*
508 		 *	( t=p , ... , FRTN( t ) ...
509 		 */
510 	    if ( p -> class == FFUNC || p -> class == FPROC ) {
511 		putop( PCC_COMOP , PCCT_INT );
512 		putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ) ,
513 			"_FRTN" );
514 		putRV((char *) 0 , cbn , tempdescrp -> value[ NL_OFFS ] ,
515 			tempdescrp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
516  		putLV((char *) 0 , cbn , savedispnp -> value[ NL_OFFS ] ,
517  			savedispnp -> extra_flags , PCCTM_PTR | PCCT_STRTY );
518  		putop( PCC_CM , PCCT_INT );
519 		putop( PCC_CALL , PCCT_INT );
520 		putop( PCC_COMOP , PCCT_INT );
521 	    }
522 		/*
523 		 *	if required:
524 		 *	either	... , temp )
525 		 *	or	... , &temp )
526 		 */
527 	    if ( porf == FUNC && temptype != PCCT_UNDEF ) {
528 		if ( temptype != PCCT_STRTY ) {
529 		    putRV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
530 			    tempnlp -> extra_flags , (int) p_type_p2type );
531 		} else {
532 		    putLV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
533 			    tempnlp -> extra_flags , (int) p_type_p2type );
534 		}
535 		putop( PCC_COMOP , PCCT_INT );
536 	    }
537 	    if ( porf == PROC ) {
538 		putdot( filename , line );
539 	    }
540 #	endif PC
541 	return (p->type);
542 }
543 
544 rvlist(al)
545 	register struct tnode *al;
546 {
547 
548 	for (; al != TR_NIL; al = al->list_node.next)
549 		(void) rvalue( al->list_node.list, NLNIL , RREQ );
550 }
551 
552     /*
553      *	check that two function/procedure namelist entries are compatible
554      */
555 bool
556 fcompat( formal , actual )
557     struct nl	*formal;
558     struct nl	*actual;
559 {
560     register struct nl	*f_chain;
561     register struct nl	*a_chain;
562     extern struct nl	*plist();
563     bool compat = TRUE;
564 
565     if ( formal == NLNIL || actual == NLNIL ) {
566 	return FALSE;
567     }
568     for (a_chain = plist(actual), f_chain = plist(formal);
569          f_chain != NLNIL;
570 	 f_chain = f_chain->chain, a_chain = a_chain->chain) {
571 	if (a_chain == NIL) {
572 	    error("%s %s declared on line %d has more arguments than",
573 		parnam(formal->class), formal->symbol,
574 		(char *) linenum(formal));
575 	    cerror("%s %s declared on line %d",
576 		parnam(actual->class), actual->symbol,
577 		(char *) linenum(actual));
578 	    return FALSE;
579 	}
580 	if ( a_chain -> class != f_chain -> class ) {
581 	    error("%s parameter %s of %s declared on line %d is not identical",
582 		parnam(f_chain->class), f_chain->symbol,
583 		formal->symbol, (char *) linenum(formal));
584 	    cerror("with %s parameter %s of %s declared on line %d",
585 		parnam(a_chain->class), a_chain->symbol,
586 		actual->symbol, (char *) linenum(actual));
587 	    compat = FALSE;
588 	} else if (a_chain->class == FFUNC || a_chain->class == FPROC) {
589 	    /*compat = (compat && fcompat(f_chain, a_chain));*/
590 	    if ((compat) && (fcompat(f_chain, a_chain)))
591 		compat = TRUE;
592 	    else compat = FALSE;
593 	}
594 	if ((a_chain->class != FPROC && f_chain->class != FPROC) &&
595 	    (a_chain->type != f_chain->type)) {
596 	    error("Type of %s parameter %s of %s declared on line %d is not identical",
597 		parnam(f_chain->class), f_chain->symbol,
598 		formal->symbol, (char *) linenum(formal));
599 	    cerror("to type of %s parameter %s of %s declared on line %d",
600 		parnam(a_chain->class), a_chain->symbol,
601 		actual->symbol, (char *) linenum(actual));
602 	    compat = FALSE;
603 	}
604     }
605     if (a_chain != NIL) {
606 	error("%s %s declared on line %d has fewer arguments than",
607 	    parnam(formal->class), formal->symbol,
608 	    (char *) linenum(formal));
609 	cerror("%s %s declared on line %d",
610 	    parnam(actual->class), actual->symbol,
611 	    (char *) linenum(actual));
612 	return FALSE;
613     }
614     return compat;
615 }
616 
617 char *
618 parnam(nltype)
619     int nltype;
620 {
621     switch(nltype) {
622 	case REF:
623 	    return "var";
624 	case VAR:
625 	    return "value";
626 	case FUNC:
627 	case FFUNC:
628 	    return "function";
629 	case PROC:
630 	case FPROC:
631 	    return "procedure";
632 	default:
633 	    return "SNARK";
634     }
635 }
636 
637 struct nl *plist(p)
638     struct nl *p;
639 {
640     switch (p->class) {
641 	case FFUNC:
642 	case FPROC:
643 	    return p->ptr[ NL_FCHAIN ];
644 	case PROC:
645 	case FUNC:
646 	    return p->chain;
647 	default:
648 	    {
649 		panic("plist");
650 		return(NLNIL); /* this is here only so lint won't complain
651 				  panic actually aborts */
652 	    }
653 
654     }
655 }
656 
657 linenum(p)
658     struct nl *p;
659 {
660     if (p->class == FUNC)
661 	return p->ptr[NL_FVAR]->value[NL_LINENO];
662     return p->value[NL_LINENO];
663 }
664