xref: /original-bsd/usr.bin/pascal/src/fend.c (revision f82e54c4)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 #ifndef lint
4 static char sccsid[] = "@(#)fend.c 2.1 02/08/84";
5 #endif
6 
7 #include "whoami.h"
8 #include "0.h"
9 #include "tree.h"
10 #include "opcode.h"
11 #include "objfmt.h"
12 #include "align.h"
13 #include "tmps.h"
14 
15 /*
16  * this array keeps the pxp counters associated with
17  * functions and procedures, so that they can be output
18  * when their bodies are encountered
19  */
20 int	bodycnts[ DSPLYSZ ];
21 
22 #ifdef PC
23 #   include "pc.h"
24 #   include "pcops.h"
25 #endif PC
26 
27 #ifdef OBJ
28 int	cntpatch;
29 int	nfppatch;
30 #endif OBJ
31 
32 #include "tree_ty.h"
33 
34 struct	nl *Fp;
35 int	pnumcnt;
36 /*
37  * Funcend is called to
38  * finish a block by generating
39  * the code for the statements.
40  * It then looks for unresolved declarations
41  * of labels, procedures and functions,
42  * and cleans up the name list.
43  * For the program, it checks the
44  * semantics of the program
45  * statement (yuchh).
46  */
47 funcend(fp, bundle, endline)
48 	struct nl *fp;
49 	struct tnode *bundle;
50 	int endline;
51 {
52 	register struct nl *p;
53 	register int i, b;
54 	int inp, out;
55 	struct tnode *blk;
56 	bool chkref;
57 	struct nl *iop;
58 	char *cp;
59 	extern int cntstat;
60 #	ifdef PC
61 	    struct entry_exit_cookie	eecookie;
62 #	endif PC
63 #	ifndef PC
64 	int var;
65 #	endif PC
66 
67 	cntstat = 0;
68 /*
69  *	yyoutline();
70  */
71 	if (program != NIL)
72 		line = program->value[3];
73 	blk = bundle->stmnt_blck.stmnt_list;
74 	if (fp == NIL) {
75 		cbn--;
76 #		ifdef PTREE
77 		    nesting--;
78 #		endif PTREE
79 		return;
80 	}
81 #ifdef OBJ
82 	/*
83 	 * Patch the branch to the
84 	 * entry point of the function
85 	 */
86 	patch4((PTR_DCL) fp->value[NL_ENTLOC]);
87 	/*
88 	 * Put out the block entrance code and the block name.
89 	 * HDRSZE is the number of bytes of info in the static
90 	 * BEG data area exclusive of the proc name. It is
91 	 * currently defined as:
92 	/*	struct hdr {
93 	/*		long framesze;	/* number of bytes of local vars */
94 	/*		long nargs;	/* number of bytes of arguments */
95 	/*		bool tests;	/* TRUE => perform runtime tests */
96 	/*		short offset;	/* offset of procedure in source file */
97 	/*		char name[1];	/* name of active procedure */
98 	/*	};
99 	 */
100 #	define HDRSZE (2 * sizeof(long) + sizeof(short) + sizeof(bool))
101 	var = put(2, ((lenstr(fp->symbol,0) + HDRSZE) << 8)
102 		| (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), (long)0);
103 	    /*
104 	     *  output the number of bytes of arguments
105 	     *  this is only checked on formal calls.
106 	     */
107 	(void) put(2, O_CASE4, cbn == 1 ? (long)0 : (long)(fp->value[NL_OFFS]-DPOFF2));
108 	    /*
109 	     *	Output the runtime test mode for the routine
110 	     */
111 	(void) put(2, sizeof(bool) == 2 ? O_CASE2 : O_CASE4, opt('t') ? TRUE : FALSE);
112 	    /*
113 	     *	Output line number and routine name
114 	     */
115 	(void) put(2, O_CASE2, bundle->stmnt_blck.line_no);
116 	putstr(fp->symbol, 0);
117 #endif OBJ
118 #ifdef PC
119 	/*
120 	 * put out the procedure entry code
121 	 */
122 	eecookie.nlp = fp;
123 	if ( fp -> class == PROG ) {
124 		/*
125 		 *	If there is a label declaration in the main routine
126 		 *	then there may be a non-local goto to it that does
127 		 *	not appear in this module. We have to assume that
128 		 *	such a reference may occur and generate code to
129 		 *	prepare for it.
130 		 */
131 	    if ( parts[ cbn ] & LPRT ) {
132 		parts[ cbn ] |= ( NONLOCALVAR | NONLOCALGOTO );
133 	    }
134 	    codeformain();
135 	    ftnno = fp -> value[NL_ENTLOC];
136 	    prog_prologue(&eecookie);
137 	    stabfunc( "program" , fp -> class ,
138 		bundle->stmnt_blck.line_no , (long) 0 );
139 	} else {
140 	    ftnno = fp -> value[NL_ENTLOC];
141 	    fp_prologue(&eecookie);
142 	    stabfunc( fp -> symbol , fp -> class ,
143 		bundle->stmnt_blck.line_no , (long) (cbn - 1) );
144 	    for ( p = fp -> chain ; p != NIL ; p = p -> chain ) {
145 		stabparam( p -> symbol , p2type( p -> type )
146 			    , p -> value[ NL_OFFS ] ,
147 				 (int) lwidth( p -> type ) );
148 	    }
149 	    if ( fp -> class == FUNC ) {
150 		    /*
151 		     *	stab the function variable
152 		     */
153 		p = fp -> ptr[ NL_FVAR ];
154 		stablvar( p -> symbol , p2type( p -> type ) , cbn
155 			, p -> value[ NL_OFFS ] , (int) lwidth( p -> type ) );
156 	    }
157 		/*
158 		 *	stab local variables
159 		 *	rummage down hash chain links.
160 		 */
161 	    for ( i = 0 ; i <= 077 ; i++ ) {
162 		for ( p = disptab[ i ] ; p != NIL ; p = p->nl_next) {
163 		    if ( ( p -> nl_block & 037 ) != cbn ) {
164 			break;
165 		    }
166 		    /*
167 		     *	stab local variables
168 		     *	that's named variables, but not params
169 		     */
170 		    if (   ( p -> symbol != NIL )
171 			&& ( p -> class == VAR )
172 			&& ( p -> value[ NL_OFFS ] < 0 ) ) {
173 			stablvar( p -> symbol , p2type( p -> type ) , cbn
174 			    , p -> value[ NL_OFFS ] , (int) lwidth( p -> type ) );
175 		    }
176 		}
177 	    }
178 	}
179 	stablbrac( cbn );
180 	    /*
181 	     *	ask second pass to allocate known locals
182 	     */
183 	putlbracket(ftnno, &sizes[cbn]);
184 	fp_entrycode(&eecookie);
185 #endif PC
186 	if ( monflg ) {
187 		if ( fp -> value[ NL_CNTR ] != 0 ) {
188 			inccnt( fp -> value [ NL_CNTR ] );
189 		}
190 		inccnt( bodycnts[ fp -> nl_block & 037 ] );
191 	}
192 	if (fp->class == PROG) {
193 		/*
194 		 * The glorious buffers option.
195 		 *          0 = don't buffer output
196 		 *          1 = line buffer output
197 		 *          2 = 512 byte buffer output
198 		 */
199 #		ifdef OBJ
200 		    if (opt('b') != 1)
201 			    (void) put(1, O_BUFF | opt('b') << 8);
202 #		endif OBJ
203 #		ifdef PC
204 		    if ( opt( 'b' ) != 1 ) {
205 			putleaf( P2ICON , 0 , 0
206 				, ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" );
207 			putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , (char *) 0 );
208 			putop( P2CALL , P2INT );
209 			putdot( filename , line );
210 		    }
211 #		endif PC
212 		inp = 0;
213 		out = 0;
214 		for (p = fp->chain; p != NIL; p = p->chain) {
215 			if (pstrcmp(p->symbol, input->symbol) == 0) {
216 				inp++;
217 				continue;
218 			}
219 			if (pstrcmp(p->symbol, output->symbol) == 0) {
220 				out++;
221 				continue;
222 			}
223 			iop = lookup1(p->symbol);
224 			if (iop == NIL || bn != cbn) {
225 				error("File %s listed in program statement but not declared", p->symbol);
226 				continue;
227 			}
228 			if (iop->class != VAR) {
229 				error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
230 				continue;
231 			}
232 			if (iop->type == NIL)
233 				continue;
234 			if (iop->type->class != FILET) {
235 				error("File %s listed in program statement but defined as %s",
236 					p->symbol, nameof(iop->type));
237 				continue;
238 			}
239 #			ifdef OBJ
240 			    (void) put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type));
241 			    i = lenstr(p->symbol,0);
242 			    (void) put(2, O_CON24, i);
243 			    (void) put(2, O_LVCON, i);
244 			    putstr(p->symbol, 0);
245 			    (void) put(2, O_LV | bn<<8+INDX, (int)iop->value[NL_OFFS]);
246 			    (void) put(1, O_DEFNAME);
247 #			endif OBJ
248 #			ifdef PC
249 			    putleaf( P2ICON , 0 , 0
250 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
251 				    , "_DEFNAME" );
252 			    putLV( p -> symbol , bn , iop -> value[NL_OFFS] ,
253 				    iop -> extra_flags , p2type( iop ) );
254 			    putCONG( p -> symbol , strlen( p -> symbol )
255 				    , LREQ );
256 			    putop( P2LISTOP , P2INT );
257 			    putleaf( P2ICON , strlen( p -> symbol )
258 				    , 0 , P2INT , (char *) 0 );
259 			    putop( P2LISTOP , P2INT );
260 			    putleaf( P2ICON
261 				, text(iop->type) ? 0 : width(iop->type->type)
262 				, 0 , P2INT , (char *) 0 );
263 			    putop( P2LISTOP , P2INT );
264 			    putop( P2CALL , P2INT );
265 			    putdot( filename , line );
266 #			endif PC
267 		}
268 	}
269 	/*
270 	 * Process the prog/proc/func body
271 	 */
272 	noreach = FALSE;
273 	line = bundle->stmnt_blck.line_no;
274 	statlist(blk);
275 #	ifdef PTREE
276 	    {
277 		pPointer Body = tCopy( blk );
278 
279 		pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
280 	    }
281 #	endif PTREE
282 #	ifdef OBJ
283 	    if (cbn== 1 && monflg != FALSE) {
284 		    patchfil((PTR_DCL) (cntpatch - 2), (long)cnts, 2);
285 		    patchfil((PTR_DCL) (nfppatch - 2), (long)pfcnt, 2);
286 	    }
287 #	endif OBJ
288 #	ifdef PC
289 	    if ( fp -> class == PROG && monflg ) {
290 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
291 			, "_PMFLUSH" );
292 		putleaf( P2ICON , cnts , 0 , P2INT , (char *) 0 );
293 		putleaf( P2ICON , pfcnt , 0 , P2INT , (char *) 0 );
294 		putop( P2LISTOP , P2INT );
295 		putLV( PCPCOUNT , 0 , 0 , NGLOBAL , P2INT );
296 		putop( P2LISTOP , P2INT );
297 		putop( P2CALL , P2INT );
298 		putdot( filename , line );
299 	    }
300 #	endif PC
301 	/*
302 	 * Clean up the symbol table displays and check for unresolves
303 	 */
304 	line = endline;
305 	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
306 		recovered();
307 		error("Input is used but not defined in the program statement");
308 	}
309 	if (fp->class == PROG && out == 0 && (output->nl_flags & (NUSED|NMOD)) != 0) {
310 		recovered();
311 		error("Output is used but not defined in the program statement");
312 	}
313 	b = cbn;
314 	Fp = fp;
315 	chkref = (syneflg == errcnt[cbn] && opt('w') == 0)?TRUE:FALSE;
316 	for (i = 0; i <= 077; i++) {
317 		for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
318 			/*
319 			 * Check for variables defined
320 			 * but not referenced
321 			 */
322 			if (chkref && p->symbol != NIL)
323 			switch (p->class) {
324 				case FIELD:
325 					/*
326 					 * If the corresponding record is
327 					 * unused, we shouldn't complain about
328 					 * the fields.
329 					 */
330 				default:
331 					if ((p->nl_flags & (NUSED|NMOD)) == 0) {
332 						warning();
333 						nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
334 						break;
335 					}
336 					/*
337 					 * If a var parameter is either
338 					 * modified or used that is enough.
339 					 */
340 					if (p->class == REF)
341 						continue;
342 #					ifdef OBJ
343 					    if ((p->nl_flags & NUSED) == 0) {
344 						warning();
345 						nerror("%s %s is never used", classes[p->class], p->symbol);
346 						break;
347 					    }
348 #					endif OBJ
349 #					ifdef PC
350 					    if (((p->nl_flags & NUSED) == 0) && ((p->extra_flags & NEXTERN) == 0)) {
351 						warning();
352 						nerror("%s %s is never used", classes[p->class], p->symbol);
353 						break;
354 					    }
355 #					endif PC
356 					if ((p->nl_flags & NMOD) == 0) {
357 						warning();
358 						nerror("%s %s is used but never set", classes[p->class], p->symbol);
359 						break;
360 					}
361 				case LABEL:
362 				case FVAR:
363 				case BADUSE:
364 					break;
365 			}
366 			switch (p->class) {
367 				case BADUSE:
368 					cp = "s";
369 					/* This used to say ud_next
370 					   that is not a member of nl so
371 					   i changed it to nl_next,
372 					   which may be wrong */
373 					if (p->chain->nl_next == NIL)
374 						cp++;
375 					eholdnl();
376 					if (p->value[NL_KINDS] & ISUNDEF)
377 						nerror("%s undefined on line%s", p->symbol, cp);
378 					else
379 						nerror("%s improperly used on line%s", p->symbol, cp);
380 					pnumcnt = 10;
381 					pnums((struct udinfo *) p->chain);
382 					pchr('\n');
383 					break;
384 
385 				case FUNC:
386 				case PROC:
387 #					ifdef OBJ
388 					    if ((p->nl_flags & NFORWD))
389 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
390 #					endif OBJ
391 #					ifdef PC
392 					    if ((p->nl_flags & NFORWD) && ((p->extra_flags & NEXTERN) == 0))
393 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
394 #					endif PC
395 					break;
396 
397 				case LABEL:
398 					if (p->nl_flags & NFORWD)
399 						nerror("label %s was declared but not defined", p->symbol);
400 					break;
401 				case FVAR:
402 					if ((p->nl_flags & NMOD) == 0)
403 						nerror("No assignment to the function variable");
404 					break;
405 			}
406 		}
407 		/*
408 		 * Pop this symbol
409 		 * table slot
410 		 */
411 		disptab[i] = p;
412 	}
413 
414 #	ifdef OBJ
415 	    (void) put(1, O_END);
416 #	endif OBJ
417 #	ifdef PC
418 	    fp_exitcode(&eecookie);
419 	    stabrbrac(cbn);
420 	    putrbracket(ftnno);
421 	    fp_epilogue(&eecookie);
422 	    if (fp -> class != PROG) {
423 		fp_formalentry(&eecookie);
424 	    }
425 		/*
426 		 *	declare pcp counters, if any
427 		 */
428 	    if ( monflg && fp -> class == PROG ) {
429 		putprintf( "	.data" , 0 );
430 		aligndot(P2INT);
431 		putprintf( "	.comm	" , 1 );
432 		putprintf( PCPCOUNT , 1 );
433 		putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) );
434 		putprintf( "	.text" , 0 );
435 	    }
436 #	endif PC
437 #ifdef DEBUG
438 	dumpnl(fp->ptr[2], (int) fp->symbol);
439 #endif
440 
441 #ifdef OBJ
442 	/*
443 	 * save the namelist for the debugger pdx
444 	 */
445 
446 	savenl(fp->ptr[2], (int) fp->symbol);
447 #endif
448 
449 	/*
450 	 * Restore the
451 	 * (virtual) name list
452 	 * position
453 	 */
454 	nlfree(fp->ptr[2]);
455 	/*
456 	 * Proc/func has been
457 	 * resolved
458 	 */
459 	fp->nl_flags &= ~NFORWD;
460 	/*
461 	 * Patch the beg
462 	 * of the proc/func to
463 	 * the proper variable size
464 	 */
465 	if (Fp == NIL)
466 		elineon();
467 #	ifdef OBJ
468 	    patchfil((PTR_DCL) var, leven(-sizes[cbn].om_max), 2);
469 #	endif OBJ
470 	cbn--;
471 	if (inpflist(fp->symbol)) {
472 		opop('l');
473 	}
474 }
475 
476 #ifdef PC
477     /*
478      *	construct the long name of a function based on it's static nesting.
479      *	into a caller-supplied buffer (that should be about BUFSIZ big).
480      */
481 sextname( buffer , name , level )
482     char	buffer[];
483     char	*name;
484     int		level;
485 {
486     char	*starthere;
487     int	i;
488 
489     starthere = &buffer[0];
490     for ( i = 1 ; i < level ; i++ ) {
491 	sprintf( starthere , EXTFORMAT , enclosing[ i ] );
492 	starthere += strlen( enclosing[ i ] ) + 1;
493     }
494     sprintf( starthere , EXTFORMAT , name );
495     starthere += strlen( name ) + 1;
496     if ( starthere >= &buffer[ BUFSIZ ] ) {
497 	panic( "sextname" );
498     }
499 }
500 
501     /*
502      *	code for main()
503      */
504 #ifdef vax
505 
506 codeformain()
507 {
508     putprintf("	.text" , 0 );
509     putprintf("	.align	1" , 0 );
510     putprintf("	.globl	_main" , 0 );
511     putprintf("_main:" , 0 );
512     putprintf("	.word	0" , 0 );
513     if ( opt ( 't' ) ) {
514 	putprintf("	pushl	$1" , 0 );
515     } else {
516 	putprintf("	pushl	$0" , 0 );
517     }
518     putprintf("	calls	$1,_PCSTART" , 0 );
519     putprintf("	movl	4(ap),__argc" , 0 );
520     putprintf("	movl	8(ap),__argv" , 0 );
521     putprintf("	calls	$0,_program" , 0 );
522     putprintf("	pushl	$0" , 0 );
523     putprintf("	calls	$1,_PCEXIT" , 0 );
524 }
525 
526     /*
527      *	prologue for the program.
528      *	different because it
529      *		doesn't have formal entry point
530      */
531 prog_prologue(eecookiep)
532     struct entry_exit_cookie	*eecookiep;
533 {
534     putprintf("	.text" , 0 );
535     putprintf("	.align	1" , 0 );
536     putprintf("	.globl	_program" , 0 );
537     putprintf("_program:" , 0 );
538 	/*
539 	 *	register save mask
540 	 */
541     eecookiep -> savlabel = (int) getlab();
542     putprintf("	.word	%s%d", 0, (int) SAVE_MASK_LABEL , eecookiep -> savlabel );
543 }
544 
545 fp_prologue(eecookiep)
546     struct entry_exit_cookie	*eecookiep;
547 {
548 
549     sextname( eecookiep -> extname, eecookiep -> nlp -> symbol , cbn - 1 );
550     putprintf( "	.text" , 0 );
551     putprintf( "	.align	1" , 0 );
552     putprintf( "	.globl	%s%s", 0, (int) FORMALPREFIX, (int) eecookiep -> extname );
553     putprintf( "	.globl	%s" , 0 , (int) eecookiep -> extname );
554     putprintf( "%s:" , 0 , (int) eecookiep -> extname );
555 	/*
556 	 *	register save mask
557 	 */
558     eecookiep -> savlabel = (int) getlab();
559     putprintf("	.word	%s%d", 0, (int) SAVE_MASK_LABEL , eecookiep -> savlabel );
560 }
561 
562     /*
563      *	code before any user code.
564      *	or code that is machine dependent.
565      */
566 fp_entrycode(eecookiep)
567     struct entry_exit_cookie	*eecookiep;
568 {
569     int	ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
570     int	proflabel = (int) getlab();
571     int	setjmp0 = (int) getlab();
572 
573 	/*
574 	 *	top of code;  destination of jump from formal entry code.
575 	 */
576     eecookiep -> toplabel = (int) getlab();
577     (void) putlab( (char *) eecookiep -> toplabel );
578     putprintf("	subl2	$%s%d,sp" , 0 , (int) FRAME_SIZE_LABEL, ftnno );
579     if ( profflag ) {
580 	    /*
581 	     *	call mcount for profiling
582 	     */
583 	putprintf( "	moval	" , 1 );
584 	putprintf( PREFIXFORMAT , 1 , (int) LABELPREFIX , proflabel );
585 	putprintf( ",r0" , 0 );
586 	putprintf( "	jsb	mcount" , 0 );
587 	putprintf( "	.data" , 0 );
588 	putprintf( "	.align	2" , 0 );
589 	(void) putlab( (char *) proflabel );
590 	putprintf( "	.long	0" , 0 );
591 	putprintf( "	.text" , 0 );
592     }
593 	/*
594 	 *	if there are nested procedures that access our variables
595 	 *	we must save the display.
596 	 */
597     if ( parts[ cbn ] & NONLOCALVAR ) {
598 	    /*
599 	     *	save old display
600 	     */
601 	putprintf( "	movq	%s+%d,%d(%s)" , 0
602 		, (int) DISPLAYNAME , cbn * sizeof(struct dispsave)
603 		, DSAVEOFFSET , (int) P2FPNAME );
604 	    /*
605 	     *	set up new display by saving AP and FP in appropriate
606 	     *	slot in display structure.
607 	     */
608 	putprintf( "	movq	%s,%s+%d" , 0
609 		, (int) P2APNAME , (int) DISPLAYNAME , cbn * sizeof(struct dispsave) );
610     }
611 	/*
612 	 *	set underflow checking if runtime tests
613 	 */
614     if ( opt( 't' ) ) {
615 	putprintf( "	bispsw	$0xe0" , 0 );
616     }
617 	/*
618 	 *	zero local variables if checking is on
619 	 *	by calling blkclr( bytes of locals , starting local address );
620 	 */
621     if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
622 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
623 		, "_blkclr" );
624 	putLV((char *) 0 , cbn , (int) sizes[ cbn ].om_max , NLOCAL , P2CHAR );
625 	putleaf( P2ICON ,  (int) (( -sizes[ cbn ].om_max ) - DPOFF1)
626 		, 0 , P2INT ,(char *) 0 );
627 	putop( P2LISTOP , P2INT );
628 	putop( P2CALL , P2INT );
629 	putdot( filename , line );
630     }
631 	/*
632 	 *  set up goto vector if non-local goto to this frame
633 	 */
634     if ( parts[ cbn ] & NONLOCALGOTO ) {
635 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
636 		, "_setjmp" );
637 	putLV( (char *) 0 , cbn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
638 	putop( P2CALL , P2INT );
639 	putleaf( P2ICON , 0 , 0 , P2INT , (char *) 0 );
640 	putop( P2NE , P2INT );
641 	putleaf( P2ICON , setjmp0 , 0 , P2INT , (char *) 0 );
642 	putop( P2CBRANCH , P2INT );
643 	putdot( filename , line );
644 	    /*
645 	     *	on non-local goto, setjmp returns with address to
646 	     *	be branched to.
647 	     */
648 	putprintf( "	jmp	(r0)" , 0 );
649 	(void) putlab((char *) setjmp0);
650     }
651 }
652 
653 fp_exitcode(eecookiep)
654     struct entry_exit_cookie	*eecookiep;
655 {
656 	/*
657 	 *	if there were file variables declared at this level
658 	 *	call PCLOSE( ap ) to clean them up.
659 	 */
660     if ( dfiles[ cbn ] ) {
661 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
662 		, "_PCLOSE" );
663 	putleaf( P2REG , 0 , P2AP , ADDTYPE( P2CHAR , P2PTR ) , (char *) 0 );
664 	putop( P2CALL , P2INT );
665 	putdot( filename , line );
666     }
667 	/*
668 	 *	if this is a function,
669 	 *	the function variable is the return value.
670 	 *	if it's a scalar valued function, return scalar,
671 	 *	else, return a pointer to the structure value.
672 	 */
673     if ( eecookiep-> nlp -> class == FUNC ) {
674 	struct nl	*fvar = eecookiep-> nlp -> ptr[ NL_FVAR ];
675 	long		fvartype = p2type( fvar -> type );
676 	long		label;
677 	char		labelname[ BUFSIZ ];
678 
679 	switch ( classify( fvar -> type ) ) {
680 	    case TBOOL:
681 	    case TCHAR:
682 	    case TINT:
683 	    case TSCAL:
684 	    case TDOUBLE:
685 	    case TPTR:
686 		putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
687 			fvar -> value[ NL_OFFS ] ,
688 			fvar -> extra_flags ,
689 			(int) fvartype );
690 		putop( P2FORCE , (int) fvartype );
691 		break;
692 	    default:
693 		label = (int) getlab();
694 		sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
695 		putprintf( "	.data" , 0 );
696 		aligndot(A_STRUCT);
697 		putprintf( "	.lcomm	%s,%d" , 0 ,
698 			    (int) labelname , (int) lwidth( fvar -> type ) );
699 		putprintf( "	.text" , 0 );
700 		putleaf( P2NAME , 0 , 0 , (int) fvartype , labelname );
701 		putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
702 			fvar -> value[ NL_OFFS ] ,
703 			fvar -> extra_flags ,
704 			(int) fvartype );
705 		putstrop( P2STASG , (int) ADDTYPE(fvartype, P2PTR) ,
706 			(int) lwidth( fvar -> type ) ,
707 			align( fvar -> type ) );
708 		putdot( filename , line );
709 		putleaf( P2ICON , 0 , 0 , (int) ADDTYPE(fvartype, P2PTR), labelname );
710 		putop( P2FORCE , (int) ADDTYPE(fvartype, P2PTR) );
711 		break;
712 	}
713 	putdot( filename , line );
714     }
715 	/*
716 	 *	if there are nested procedures we must save the display.
717 	 */
718     if ( parts[ cbn ] & NONLOCALVAR ) {
719 	    /*
720 	     *	restore old display entry from save area
721 	     */
722 	putprintf( "	movq	%d(%s),%s+%d" , 0
723 	    , DSAVEOFFSET , (int) P2FPNAME
724 	    , (int) DISPLAYNAME , cbn * sizeof(struct dispsave) );
725     }
726 }
727 
728 fp_epilogue(eecookiep)
729     struct entry_exit_cookie	*eecookiep;
730 {
731     putprintf("	ret" , 0 );
732 	/*
733 	 *	set the register save mask.
734 	 */
735     putprintf("	.set	%s%d,0x%x", 0,
736 		(int) SAVE_MASK_LABEL, eecookiep -> savlabel, savmask());
737 }
738 
739 fp_formalentry(eecookiep)
740     struct entry_exit_cookie	*eecookiep;
741 {
742 
743     putprintf("	.align 1", 0);
744     putprintf("%s%s:" , 0 , (int) FORMALPREFIX , (int) eecookiep -> extname );
745     putprintf("	.word	%s%d", 0, (int) SAVE_MASK_LABEL, eecookiep -> savlabel );
746     putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_FCALL" );
747     putRV((char *) 0 , cbn ,
748 	eecookiep -> nlp -> value[ NL_OFFS ] + sizeof( struct formalrtn * ) ,
749 	NPARAM , P2PTR | P2STRTY );
750     putRV((char *) 0, cbn, eecookiep -> nlp -> value[NL_OFFS], NPARAM, P2PTR|P2STRTY);
751     putop( P2LISTOP , P2INT );
752     putop( P2CALL , P2INT );
753     putdot( filename , line );
754     putjbr( (long) eecookiep -> toplabel );
755 }
756 #endif vax
757 
758 #ifdef mc68000
759 
760 codeformain()
761 {
762     putprintf("	.text", 0);
763     putprintf("	.globl	_main", 0);
764     putprintf("_main:", 0);
765     putprintf("	link	%s,#0", 0, P2FPNAME);
766     if (opt('t')) {
767 	putprintf("	pea	1", 0);
768     } else {
769 	putprintf("	pea	0", 0);
770     }
771     putprintf("	jbsr	_PCSTART", 0);
772     putprintf("	addql	#4,sp", 0);
773     putprintf("	movl	%s@(8),__argc", 0, P2FPNAME);
774     putprintf("	movl	%s@(12),__argv", 0, P2FPNAME);
775     putprintf("	jbsr	_program", 0);
776     putprintf("	pea	0", 0);
777     putprintf("	jbsr	_PCEXIT", 0);
778 }
779 
780 prog_prologue(eecookiep)
781     struct entry_exit_cookie	*eecookiep;
782 {
783     int	ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
784 
785     putprintf("	.text", 0);
786     putprintf("	.globl	_program", 0);
787     putprintf("_program:", 0);
788     putprintf("	link	%s,#0", 0, P2FPNAME);
789     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
790 	/* touch new end of stack, to break more stack space */
791     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
792     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
793 }
794 
795 fp_prologue(eecookiep)
796     struct entry_exit_cookie	*eecookiep;
797 {
798     int		ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
799 
800     sextname(eecookiep -> extname, eecookiep -> nlp -> symbol, cbn - 1);
801     putprintf("	.text", 0);
802     putprintf("	.globl	%s%s", 0, FORMALPREFIX, eecookiep -> extname);
803     putprintf("	.globl	%s", 0, eecookiep -> extname);
804     putprintf("%s:", 0, eecookiep -> extname);
805     putprintf("	link	%s,#0", 0, P2FPNAME);
806     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
807 	/* touch new end of stack, to break more stack space */
808     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
809     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
810 }
811 
812 fp_entrycode(eecookiep)
813     struct entry_exit_cookie	*eecookiep;
814 {
815     char *proflabel = getlab();
816     char *setjmp0 = getlab();
817 
818 	/*
819 	 *	fill in the label cookie
820 	 */
821     eecookiep -> toplabel = getlab();
822     (void) putlab(eecookiep -> toplabel);
823 	/*
824 	 *	call mcount if we are profiling.
825 	 */
826     if ( profflag ) {
827 	putprintf("	movl	#%s%d,a0", 0, LABELPREFIX,  proflabel);
828 	putprintf("	jsr	mcount", 0);
829 	putprintf("	.data", 0);
830 	putprintf("	.even", 0);
831 	(void) putlab(proflabel);
832 	putprintf("	.long	0", 0);
833 	putprintf("	.text", 0);
834     }
835 	/*
836 	 *	if there are nested procedures that access our variables
837 	 *	we must save the display
838 	 */
839     if (parts[cbn] & NONLOCALVAR) {
840 	    /*
841 	     *	save the old display
842 	     */
843 	putprintf("	movl	%s+%d,%s@(%d)", 0,
844 		    DISPLAYNAME, cbn * sizeof(struct dispsave),
845 		    P2FPNAME, DSAVEOFFSET);
846 	    /*
847 	     *	set up the new display by saving the framepointer
848 	     *	in the display structure.
849 	     */
850 	putprintf("	movl	%s,%s+%d", 0,
851 		    P2FPNAME, DISPLAYNAME, cbn * sizeof(struct dispsave));
852     }
853 	/*
854 	 *	zero local variables if checking is on
855 	 *	by calling blkclr( bytes of locals , starting local address );
856 	 */
857     if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
858 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
859 		, "_blkclr" );
860 	putLV( 0 , cbn , sizes[ cbn ].om_max , NLOCAL , P2CHAR );
861 	putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
862 		, 0 , P2INT , 0 );
863 	putop( P2LISTOP , P2INT );
864 	putop( P2CALL , P2INT );
865 	putdot( filename , line );
866     }
867 	/*
868 	 *  set up goto vector if non-local goto to this frame
869 	 */
870     if ( parts[ cbn ] & NONLOCALGOTO ) {
871 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
872 		, "_setjmp" );
873 	putLV( 0 , cbn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
874 	putop( P2CALL , P2INT );
875 	putleaf( P2ICON , 0 , 0 , P2INT , 0 );
876 	putop( P2NE , P2INT );
877 	putleaf( P2ICON , setjmp0 , 0 , P2INT , 0 );
878 	putop( P2CBRANCH , P2INT );
879 	putdot( filename , line );
880 	    /*
881 	     *	on non-local goto, setjmp returns with address to
882 	     *	be branched to.
883 	     */
884 	putprintf("	movl	d0,a0", 0);
885 	putprintf("	jmp	a0@", 0);
886 	(void) putlab(setjmp0);
887     }
888 }
889 
890 fp_exitcode(eecookiep)
891     struct entry_exit_cookie	*eecookiep;
892 {
893 	/*
894 	 *	if there were file variables declared at this level
895 	 *	call PCLOSE( ap ) to clean them up.
896 	 */
897     if ( dfiles[ cbn ] ) {
898 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
899 		, "_PCLOSE" );
900 	putleaf( P2REG , 0 , P2AP , ADDTYPE( P2CHAR , P2PTR ) , 0 );
901 	putop( P2CALL , P2INT );
902 	putdot( filename , line );
903     }
904 	/*
905 	 *	if this is a function,
906 	 *	the function variable is the return value.
907 	 *	if it's a scalar valued function, return scalar,
908 	 *	else, return a pointer to the structure value.
909 	 */
910     if ( eecookiep -> nlp -> class == FUNC ) {
911 	struct nl	*fvar = eecookiep -> nlp -> ptr[ NL_FVAR ];
912 	long		fvartype = p2type( fvar -> type );
913 	char		*label;
914 	char		labelname[ BUFSIZ ];
915 
916 	switch ( classify( fvar -> type ) ) {
917 	    case TBOOL:
918 	    case TCHAR:
919 	    case TINT:
920 	    case TSCAL:
921 	    case TDOUBLE:
922 	    case TPTR:
923 		putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
924 			fvar -> value[ NL_OFFS ] ,
925 			fvar -> extra_flags ,
926 			fvartype );
927 		putop( P2FORCE , fvartype );
928 		break;
929 	    default:
930 		label = getlab();
931 		sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
932 		putprintf("	.lcomm	%s,%d", 0,
933 			labelname, lwidth(fvar -> type));
934 		putleaf( P2NAME , 0 , 0 , fvartype , labelname );
935 		putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
936 			fvar -> value[ NL_OFFS ] ,
937 			fvar -> extra_flags ,
938 			fvartype );
939 		putstrop( P2STASG , ADDTYPE(fvartype, P2PTR) ,
940 			lwidth( fvar -> type ) ,
941 			align( fvar -> type ) );
942 		putdot( filename , line );
943 		putleaf( P2ICON , 0 , 0 , ADDTYPE(fvartype, P2PTR), labelname );
944 		putop( P2FORCE , ADDTYPE(fvartype, P2PTR) );
945 		break;
946 	}
947 	putdot( filename , line );
948     }
949 	/*
950 	 *	if we saved a display, we must restore it.
951 	 */
952     if ( parts[ cbn ] & NONLOCALVAR ) {
953 	    /*
954 	     *	restore old display entry from save area
955 	     */
956 	putprintf("	movl	%s@(%d),%s+%d", 0,
957 		    P2FPNAME, DSAVEOFFSET,
958 		    DISPLAYNAME, cbn * sizeof(struct dispsave));
959     }
960 }
961 
962 fp_epilogue(eecookiep)
963     struct entry_exit_cookie	*eecookiep;
964 {
965     /*
966      *	all done by the second pass.
967      */
968 }
969 
970 fp_formalentry(eecookiep)
971     struct entry_exit_cookie	*eecookiep;
972 {
973     putprintf( "%s%s:" , 0 , FORMALPREFIX , eecookiep -> extname );
974     putprintf("	link	%s,#0", 0, P2FPNAME);
975     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
976 	/* touch new end of stack, to break more stack space */
977     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
978     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
979     putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_FCALL" );
980     putRV( 0 , cbn ,
981 	eecookiep -> nlp -> value[ NL_OFFS ] + sizeof( struct formalrtn * ) ,
982 	NPARAM , P2PTR | P2STRTY );
983     putRV(0, cbn, eecookiep -> nlp -> value[NL_OFFS], NPARAM, P2PTR|P2STRTY);
984     putop( P2LISTOP , P2INT );
985     putop( P2CALL , P2INT );
986     putdot( filename , line );
987     putjbr( eecookiep -> toplabel );
988 }
989 #endif mc68000
990 #endif PC
991