xref: /csrg-svn/usr.bin/pascal/src/fend.c (revision 9127)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fend.c 1.15 11/11/82";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "tree.h"
8 #include "opcode.h"
9 #include "objfmt.h"
10 #include "align.h"
11 
12 /*
13  * this array keeps the pxp counters associated with
14  * functions and procedures, so that they can be output
15  * when their bodies are encountered
16  */
17 int	bodycnts[ DSPLYSZ ];
18 
19 #ifdef PC
20 #   include "pc.h"
21 #   include "pcops.h"
22 #endif PC
23 
24 #ifdef OBJ
25 int	cntpatch;
26 int	nfppatch;
27 #endif OBJ
28 
29 struct	nl *Fp;
30 int	pnumcnt;
31 /*
32  * Funcend is called to
33  * finish a block by generating
34  * the code for the statements.
35  * It then looks for unresolved declarations
36  * of labels, procedures and functions,
37  * and cleans up the name list.
38  * For the program, it checks the
39  * semantics of the program
40  * statement (yuchh).
41  */
42 funcend(fp, bundle, endline)
43 	struct nl *fp;
44 	int *bundle;
45 	int endline;
46 {
47 	register struct nl *p;
48 	register int i, b;
49 	int var, inp, out, *blk;
50 	bool chkref;
51 	struct nl *iop;
52 	char *cp;
53 	extern int cntstat;
54 #	ifdef PC
55 	    int		savlabel = getlab();
56 	    int		toplabel = getlab();
57 	    int		proflabel = getlab();
58 	    int		skip = getlab();
59 	    char	extname[ BUFSIZ ];
60 #	endif PC
61 
62 	cntstat = 0;
63 /*
64  *	yyoutline();
65  */
66 	if (program != NIL)
67 		line = program->value[3];
68 	blk = bundle[2];
69 	if (fp == NIL) {
70 		cbn--;
71 #		ifdef PTREE
72 		    nesting--;
73 #		endif PTREE
74 		return;
75 	}
76 #ifdef OBJ
77 	/*
78 	 * Patch the branch to the
79 	 * entry point of the function
80 	 */
81 	patch4(fp->value[NL_ENTLOC]);
82 	/*
83 	 * Put out the block entrance code and the block name.
84 	 * HDRSZE is the number of bytes of info in the static
85 	 * BEG data area exclusive of the proc name. It is
86 	 * currently defined as:
87 	/*	struct hdr {
88 	/*		long framesze;	/* number of bytes of local vars */
89 	/*		long nargs;	/* number of bytes of arguments */
90 	/*		bool tests;	/* TRUE => perform runtime tests */
91 	/*		short offset;	/* offset of procedure in source file */
92 	/*		char name[1];	/* name of active procedure */
93 	/*	};
94 	 */
95 #	define HDRSZE (2 * sizeof(long) + sizeof(short) + sizeof(bool))
96 	var = put(2, ((lenstr(fp->symbol,0) + HDRSZE) << 8)
97 		| (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), (long)0);
98 	    /*
99 	     *  output the number of bytes of arguments
100 	     *  this is only checked on formal calls.
101 	     */
102 	put(2, O_CASE4, cbn == 1 ? (long)0 : (long)(fp->value[NL_OFFS]-DPOFF2));
103 	    /*
104 	     *	Output the runtime test mode for the routine
105 	     */
106 	put(2, sizeof(bool) == 2 ? O_CASE2 : O_CASE4, opt('t') ? TRUE : FALSE);
107 	    /*
108 	     *	Output line number and routine name
109 	     */
110 	put(2, O_CASE2, bundle[1]);
111 	putstr(fp->symbol, 0);
112 #endif OBJ
113 #ifdef PC
114 	/*
115 	 * put out the procedure entry code
116 	 */
117 	if ( fp -> class == PROG ) {
118 	    putprintf( "	.text" , 0 );
119 	    putprintf( "	.align	1" , 0 );
120 	    putprintf( "	.globl	_main" , 0 );
121 	    putprintf( "_main:" , 0 );
122 	    putprintf( "	.word	0" , 0 );
123 	    if ( opt ( 't' ) ) {
124 	        putprintf( "	pushl	$1" , 0 );
125 	    } else {
126 	        putprintf( "	pushl	$0" , 0 );
127 	    }
128 	    putprintf( "	calls	$1,_PCSTART" , 0 );
129 	    putprintf( "	movl	4(ap),__argc" , 0 );
130 	    putprintf( "	movl	8(ap),__argv" , 0 );
131 	    putprintf( "	calls	$0,_program" , 0 );
132 	    putprintf( "	pushl	$0" , 0 );
133 	    putprintf( "	calls	$1,_PCEXIT" , 0 );
134 	    ftnno = fp -> value[NL_ENTLOC];
135 	    putprintf( "	.text" , 0 );
136 	    putprintf( "	.align	1" , 0 );
137 	    putprintf( "	.globl	_program" , 0 );
138 	    putprintf( "_program:" , 0 );
139 	    stabfunc( "program" , fp -> class , bundle[1] , 0 );
140 	} else {
141 	    ftnno = fp -> value[NL_ENTLOC];
142 	    putprintf( "	.text" , 0 );
143 	    putprintf( "	.align	1" , 0 );
144 	    sextname( extname , fp -> symbol , cbn - 1 );
145 	    putprintf( "	.globl	%s%s" , 0 , FORMALPREFIX , extname );
146 	    putprintf( "	.globl	%s" , 0 , extname );
147 	    putprintf( "%s:" , 0 , extname );
148 	    stabfunc( fp -> symbol , fp -> class , bundle[1] , cbn - 1 );
149 	    for ( p = fp -> chain ; p != NIL ; p = p -> chain ) {
150 		stabparam( p -> symbol , p2type( p -> type )
151 			    , p -> value[ NL_OFFS ] , lwidth( p -> type ) );
152 	    }
153 	    if ( fp -> class == FUNC ) {
154 		    /*
155 		     *	stab the function variable
156 		     */
157 		p = fp -> ptr[ NL_FVAR ];
158 		stablvar( p -> symbol , p2type( p -> type ) , cbn
159 			, p -> value[ NL_OFFS ] , lwidth( p -> type ) );
160 	    }
161 		/*
162 		 *	stab local variables
163 		 *	rummage down hash chain links.
164 		 */
165 	    for ( i = 0 ; i <= 077 ; i++ ) {
166 		for ( p = disptab[ i ] ; p != NIL ; p = p->nl_next) {
167 		    if ( ( p -> nl_block & 037 ) != cbn ) {
168 			break;
169 		    }
170 		    /*
171 		     *	stab local variables
172 		     *	that's named variables, but not params
173 		     */
174 		    if (   ( p -> symbol != NIL )
175 			&& ( p -> class == VAR )
176 			&& ( p -> value[ NL_OFFS ] < 0 ) ) {
177 			stablvar( p -> symbol , p2type( p -> type ) , cbn
178 			    , p -> value[ NL_OFFS ] , lwidth( p -> type ) );
179 		    }
180 		}
181 	    }
182 	}
183 	stablbrac( cbn );
184 	    /*
185 	     *	register save mask
186 	     */
187 	putprintf( "	.word	" , 1 );
188         putprintf( PREFIXFORMAT , 0 , LABELPREFIX , savlabel );
189 	putlab( toplabel );
190 	putprintf( "	subl2	$LF%d,sp" , 0 , ftnno );
191 	if ( profflag ) {
192 		/*
193 		 *	call mcount for profiling
194 		 */
195 	    putprintf( "	moval	" , 1 );
196 	    putprintf( PREFIXFORMAT , 1 , LABELPREFIX , proflabel );
197 	    putprintf( ",r0" , 0 );
198 	    putprintf( "	jsb	mcount" , 0 );
199 	    putprintf( "	.data" , 0 );
200 	    putprintf( "	.align	2" , 0 );
201 	    putlab( proflabel );
202 	    putprintf( "	.long	0" , 0 );
203 	    putprintf( "	.text" , 0 );
204 	}
205 	    /*
206 	     *	if there are nested procedures we must save the display.
207 	     */
208 	if ( parts[ cbn ] & NONLOCALVAR ) {
209 		/*
210 		 *	save old display
211 		 */
212 	    putprintf( "	movq	%s+%d,%d(%s)" , 0
213 		    , DISPLAYNAME , cbn * sizeof(struct dispsave)
214 		    , DSAVEOFFSET , P2FPNAME );
215 		/*
216 		 *	set up new display by saving AP and FP in appropriate
217 		 *	slot in display structure.
218 		 */
219 	    putprintf( "	movq	%s,%s+%d" , 0
220 		    , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) );
221 	}
222 	    /*
223 	     *	set underflow checking if runtime tests
224 	     */
225 	if ( opt( 't' ) ) {
226 	    putprintf( "	bispsw	$0xe0" , 0 );
227 	}
228 	    /*
229 	     *	ask second pass to allocate known locals
230 	     */
231 	putlbracket( ftnno , -sizes[ cbn ].om_max );
232 	    /*
233 	     *	and zero them if checking is on
234 	     *	by calling blkclr( bytes of locals , starting local address );
235 	     */
236 	if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
237 	    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
238 		    , "_blkclr" );
239 	    putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
240 		    , 0 , P2INT , 0 );
241 	    putLV( 0 , cbn , sizes[ cbn ].om_max , NLOCAL , P2CHAR );
242 	    putop( P2LISTOP , P2INT );
243 	    putop( P2CALL , P2INT );
244 	    putdot( filename , line );
245 	}
246 	    /*
247 	     *  set up goto vector if potential non-local goto to this frame
248 	     */
249 	if ( ( cbn < 2 && ( parts[ cbn ] & LPRT ) ) ||
250 	    ( parts[ cbn ] & NONLOCALGOTO ) != 0 ) {
251 	    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
252 		    , "_setjmp" );
253 	    putLV( 0 , cbn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
254 	    putop( P2CALL , P2INT );
255 	    putleaf( P2ICON , 0 , 0 , P2INT , 0 );
256 	    putop( P2NE , P2INT );
257 	    putleaf( P2ICON , skip , 0 , P2INT , 0 );
258 	    putop( P2CBRANCH , P2INT );
259 	    putdot( filename , line );
260 		/*
261 		 *	on non-local goto, setjmp returns with address to
262 		 *	be branched to.
263 		 */
264 	    putprintf( "	jmp	(r0)" , 0 );
265 	    putlab(skip);
266 	}
267 #endif PC
268 	if ( monflg ) {
269 		if ( fp -> value[ NL_CNTR ] != 0 ) {
270 			inccnt( fp -> value [ NL_CNTR ] );
271 		}
272 		inccnt( bodycnts[ fp -> nl_block & 037 ] );
273 	}
274 	if (fp->class == PROG) {
275 		/*
276 		 * The glorious buffers option.
277 		 *          0 = don't buffer output
278 		 *          1 = line buffer output
279 		 *          2 = 512 byte buffer output
280 		 */
281 #		ifdef OBJ
282 		    if (opt('b') != 1)
283 			    put(1, O_BUFF | opt('b') << 8);
284 #		endif OBJ
285 #		ifdef PC
286 		    if ( opt( 'b' ) != 1 ) {
287 			putleaf( P2ICON , 0 , 0
288 				, ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" );
289 			putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 );
290 			putop( P2CALL , P2INT );
291 			putdot( filename , line );
292 		    }
293 #		endif PC
294 		inp = 0;
295 		out = 0;
296 		for (p = fp->chain; p != NIL; p = p->chain) {
297 			if (strcmp(p->symbol, input->symbol) == 0) {
298 				inp++;
299 				continue;
300 			}
301 			if (strcmp(p->symbol, output->symbol) == 0) {
302 				out++;
303 				continue;
304 			}
305 			iop = lookup1(p->symbol);
306 			if (iop == NIL || bn != cbn) {
307 				error("File %s listed in program statement but not declared", p->symbol);
308 				continue;
309 			}
310 			if (iop->class != VAR) {
311 				error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
312 				continue;
313 			}
314 			if (iop->type == NIL)
315 				continue;
316 			if (iop->type->class != FILET) {
317 				error("File %s listed in program statement but defined as %s",
318 					p->symbol, nameof(iop->type));
319 				continue;
320 			}
321 #			ifdef OBJ
322 			    put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type));
323 			    i = lenstr(p->symbol,0);
324 			    put(2, O_CON24, i);
325 			    put(2, O_LVCON, i);
326 			    putstr(p->symbol, 0);
327 			    put(2, O_LV | bn<<8+INDX, (int)iop->value[NL_OFFS]);
328 			    put(1, O_DEFNAME);
329 #			endif OBJ
330 #			ifdef PC
331 			    putleaf( P2ICON , 0 , 0
332 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
333 				    , "_DEFNAME" );
334 			    putLV( p -> symbol , bn , iop -> value[NL_OFFS] ,
335 				    iop -> extra_flags , p2type( iop ) );
336 			    putCONG( p -> symbol , strlen( p -> symbol )
337 				    , LREQ );
338 			    putop( P2LISTOP , P2INT );
339 			    putleaf( P2ICON , strlen( p -> symbol )
340 				    , 0 , P2INT , 0 );
341 			    putop( P2LISTOP , P2INT );
342 			    putleaf( P2ICON
343 				, text(iop->type) ? 0 : width(iop->type->type)
344 				, 0 , P2INT , 0 );
345 			    putop( P2LISTOP , P2INT );
346 			    putop( P2CALL , P2INT );
347 			    putdot( filename , line );
348 #			endif PC
349 		}
350 	}
351 	/*
352 	 * Process the prog/proc/func body
353 	 */
354 	noreach = 0;
355 	line = bundle[1];
356 	statlist(blk);
357 #	ifdef PTREE
358 	    {
359 		pPointer Body = tCopy( blk );
360 
361 		pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
362 	    }
363 #	endif PTREE
364 #	ifdef OBJ
365 	    if (cbn== 1 && monflg != 0) {
366 		    patchfil(cntpatch - 2, (long)cnts, 2);
367 		    patchfil(nfppatch - 2, (long)pfcnt, 2);
368 	    }
369 #	endif OBJ
370 #	ifdef PC
371 	    if ( fp -> class == PROG && monflg ) {
372 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
373 			, "_PMFLUSH" );
374 		putleaf( P2ICON , cnts , 0 , P2INT , 0 );
375 		putleaf( P2ICON , pfcnt , 0 , P2INT , 0 );
376 		putop( P2LISTOP , P2INT );
377 		putLV( PCPCOUNT , 0 , 0 , NGLOBAL , P2INT );
378 		putop( P2LISTOP , P2INT );
379 		putop( P2CALL , P2INT );
380 		putdot( filename , line );
381 	    }
382 #	endif PC
383 	/*
384 	 * Clean up the symbol table displays and check for unresolves
385 	 */
386 	line = endline;
387 	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
388 		recovered();
389 		error("Input is used but not defined in the program statement");
390 	}
391 	if (fp->class == PROG && out == 0 && (output->nl_flags & (NUSED|NMOD)) != 0) {
392 		recovered();
393 		error("Output is used but not defined in the program statement");
394 	}
395 	b = cbn;
396 	Fp = fp;
397 	chkref = syneflg == errcnt[cbn] && opt('w') == 0;
398 	for (i = 0; i <= 077; i++) {
399 		for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
400 			/*
401 			 * Check for variables defined
402 			 * but not referenced
403 			 */
404 			if (chkref && p->symbol != NIL)
405 			switch (p->class) {
406 				case FIELD:
407 					/*
408 					 * If the corresponding record is
409 					 * unused, we shouldn't complain about
410 					 * the fields.
411 					 */
412 				default:
413 					if ((p->nl_flags & (NUSED|NMOD)) == 0) {
414 						warning();
415 						nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
416 						break;
417 					}
418 					/*
419 					 * If a var parameter is either
420 					 * modified or used that is enough.
421 					 */
422 					if (p->class == REF)
423 						continue;
424 #					ifdef OBJ
425 					    if ((p->nl_flags & NUSED) == 0) {
426 						warning();
427 						nerror("%s %s is never used", classes[p->class], p->symbol);
428 						break;
429 					    }
430 #					endif OBJ
431 #					ifdef PC
432 					    if (((p->nl_flags & NUSED) == 0) && ((p->extra_flags & NEXTERN) == 0)) {
433 						warning();
434 						nerror("%s %s is never used", classes[p->class], p->symbol);
435 						break;
436 					    }
437 #					endif PC
438 					if ((p->nl_flags & NMOD) == 0) {
439 						warning();
440 						nerror("%s %s is used but never set", classes[p->class], p->symbol);
441 						break;
442 					}
443 				case LABEL:
444 				case FVAR:
445 				case BADUSE:
446 					break;
447 			}
448 			switch (p->class) {
449 				case BADUSE:
450 					cp = "s";
451 					if (p->chain->ud_next == NIL)
452 						cp++;
453 					eholdnl();
454 					if (p->value[NL_KINDS] & ISUNDEF)
455 						nerror("%s undefined on line%s", p->symbol, cp);
456 					else
457 						nerror("%s improperly used on line%s", p->symbol, cp);
458 					pnumcnt = 10;
459 					pnums(p->chain);
460 					pchr('\n');
461 					break;
462 
463 				case FUNC:
464 				case PROC:
465 #					ifdef OBJ
466 					    if ((p->nl_flags & NFORWD))
467 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
468 #					endif OBJ
469 #					ifdef PC
470 					    if ((p->nl_flags & NFORWD) && ((p->extra_flags & NEXTERN) == 0))
471 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
472 #					endif PC
473 					break;
474 
475 				case LABEL:
476 					if (p->nl_flags & NFORWD)
477 						nerror("label %s was declared but not defined", p->symbol);
478 					break;
479 				case FVAR:
480 					if ((p->nl_flags & NMOD) == 0)
481 						nerror("No assignment to the function variable");
482 					break;
483 			}
484 		}
485 		/*
486 		 * Pop this symbol
487 		 * table slot
488 		 */
489 		disptab[i] = p;
490 	}
491 
492 #	ifdef OBJ
493 	    put(1, O_END);
494 #	endif OBJ
495 #	ifdef PC
496 		/*
497 		 *	if there were file variables declared at this level
498 		 *	call PCLOSE( ap ) to clean them up.
499 		 */
500 	    if ( dfiles[ cbn ] ) {
501 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
502 			, "_PCLOSE" );
503 		putleaf( P2REG , 0 , P2AP , ADDTYPE( P2CHAR , P2PTR ) , 0 );
504 		putop( P2CALL , P2INT );
505 		putdot( filename , line );
506 	    }
507 		/*
508 		 *	if this is a function,
509 		 *	the function variable is the return value.
510 		 *	if it's a scalar valued function, return scalar,
511 		 *	else, return a pointer to the structure value.
512 		 */
513 	    if ( fp -> class == FUNC ) {
514 		struct nl	*fvar = fp -> ptr[ NL_FVAR ];
515 		long		fvartype = p2type( fvar -> type );
516 		long		label;
517 		char		labelname[ BUFSIZ ];
518 
519 		switch ( classify( fvar -> type ) ) {
520 		    case TBOOL:
521 		    case TCHAR:
522 		    case TINT:
523 		    case TSCAL:
524 		    case TDOUBLE:
525 		    case TPTR:
526 			putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
527 				fvar -> value[ NL_OFFS ] ,
528 				fvar -> extra_flags ,
529 				fvartype );
530 			break;
531 		    default:
532 			label = getlab();
533 			sprintf( labelname , PREFIXFORMAT ,
534 				LABELPREFIX , label );
535 			putprintf( "	.data" , 0 );
536 			putprintf( "	.lcomm	%s,%d" , 0 ,
537 				    labelname , lwidth( fvar -> type ) );
538 			putprintf( "	.text" , 0 );
539 			putleaf( P2NAME , 0 , 0 , fvartype , labelname );
540 			putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
541 				fvar -> value[ NL_OFFS ] ,
542 				fvar -> extra_flags ,
543 				fvartype );
544 			putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
545 				align( fvar -> type ) );
546 			putdot( filename , line );
547 			putleaf( P2ICON , 0 , 0 , fvartype , labelname );
548 			break;
549 		}
550 		putop( P2FORCE , fvartype );
551 		putdot( filename , line );
552 	    }
553 		/*
554 		 *	if there are nested procedures we must save the display.
555 		 */
556 	    if ( parts[ cbn ] & NONLOCALVAR ) {
557 		    /*
558 		     *	restore old display entry from save area
559 		     */
560 		putprintf( "	movq	%d(%s),%s+%d" , 0
561 		    , DSAVEOFFSET , P2FPNAME
562 		    , DISPLAYNAME , cbn * sizeof(struct dispsave) );
563 	    }
564 	    stabrbrac( cbn );
565 	    putprintf( "	ret" , 0 );
566 		/*
567 		 *	let the second pass allocate locals
568 		 * 	and registers
569 		 */
570 	    putprintf( "	.set	" , 1 );
571 	    putprintf( PREFIXFORMAT , 1 , LABELPREFIX , savlabel );
572 	    putprintf( ", 0x%x" , 0 , savmask() );
573 	    putrbracket( ftnno );
574 		/*
575 		 *  put down the entry point for formal calls
576 		 *  the arguments for FCALL have been passed to us
577 		 *  as hidden parameters after the regular arguments.
578 		 */
579 	    if ( fp -> class != PROG ) {
580 		putprintf( "%s%s:" , 0 , FORMALPREFIX , extname );
581 		putprintf( "	.word	" , 1 );
582 		putprintf( PREFIXFORMAT , 0 , LABELPREFIX , savlabel );
583 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) ,
584 			"_FCALL" );
585 		putRV( 0 , cbn ,
586 		    fp -> value[ NL_OFFS ] + sizeof( struct formalrtn * ) ,
587 		    NPARAM ,
588 		    P2PTR | P2STRTY );
589 		putRV( 0 , cbn , fp -> value[ NL_OFFS ] ,
590 			NPARAM , P2PTR|P2STRTY );
591 		putop( P2LISTOP , P2INT );
592 		putop( P2CALL , P2INT );
593 		putdot( filename , line );
594 		putjbr( toplabel );
595 	    }
596 		/*
597 		 *	declare pcp counters, if any
598 		 */
599 	    if ( monflg && fp -> class == PROG ) {
600 		putprintf( "	.data" , 0 );
601 		putprintf( "	.comm	" , 1 );
602 		putprintf( PCPCOUNT , 1 );
603 		putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) );
604 		putprintf( "	.text" , 0 );
605 	    }
606 #	endif PC
607 #ifdef DEBUG
608 	dumpnl(fp->ptr[2], fp->symbol);
609 #endif
610 
611 #ifdef OBJ
612 	/*
613 	 * save the namelist for the debugger pdx
614 	 */
615 
616 	savenl(fp->ptr[2], fp->symbol);
617 #endif
618 
619 	/*
620 	 * Restore the
621 	 * (virtual) name list
622 	 * position
623 	 */
624 	nlfree(fp->ptr[2]);
625 	/*
626 	 * Proc/func has been
627 	 * resolved
628 	 */
629 	fp->nl_flags &= ~NFORWD;
630 	/*
631 	 * Patch the beg
632 	 * of the proc/func to
633 	 * the proper variable size
634 	 */
635 	if (Fp == NIL)
636 		elineon();
637 #	ifdef OBJ
638 	    patchfil(var, (long)(-sizes[cbn].om_max), 2);
639 #	endif OBJ
640 	cbn--;
641 	if (inpflist(fp->symbol)) {
642 		opop('l');
643 	}
644 }
645 
646 #ifdef PC
647     /*
648      *	construct the long name of a function based on it's static nesting.
649      *	into a caller-supplied buffer (that should be about BUFSIZ big).
650      */
651 sextname( buffer , name , level )
652     char	buffer[];
653     char	*name;
654     int		level;
655 {
656     char	*starthere;
657     int	i;
658 
659     starthere = &buffer[0];
660     for ( i = 1 ; i < level ; i++ ) {
661 	sprintf( starthere , EXTFORMAT , enclosing[ i ] );
662 	starthere += strlen( enclosing[ i ] ) + 1;
663     }
664     sprintf( starthere , EXTFORMAT , name );
665     starthere += strlen( name ) + 1;
666     if ( starthere >= &buffer[ BUFSIZ ] ) {
667 	panic( "sextname" );
668     }
669 }
670 #endif PC
671