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