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