xref: /csrg-svn/usr.bin/pascal/src/fend.c (revision 10714)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fend.c 1.19 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 
524 fp_prologue(eecookiep)
525     struct entry_exit_cookie	*eecookiep;
526 {
527     int		ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
528 
529     sextname( eecookiep -> extname, eecookiep -> nlp -> symbol , cbn - 1 );
530     putprintf( "	.text" , 0 );
531     putprintf( "	.align	1" , 0 );
532     putprintf( "	.globl	%s%s", 0, FORMALPREFIX, eecookiep -> extname );
533     putprintf( "	.globl	%s" , 0 , eecookiep -> extname );
534     putprintf( "%s:" , 0 , eecookiep -> extname );
535 	/*
536 	 *	register save mask
537 	 */
538     eecookiep -> savlabel = getlab();
539     putprintf("	.word	%s%d", 0, SAVE_MASK_LABEL , eecookiep -> savlabel );
540 }
541 
542     /*
543      *	code before any user code.
544      *	or code that is machine dependent.
545      */
546 fp_entrycode(eecookiep)
547     struct entry_exit_cookie	*eecookiep;
548 {
549     int	ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
550     int	proflabel = getlab();
551     int	setjmp0 = getlab();
552 
553 	/*
554 	 *	top of code;  destination of jump from formal entry code.
555 	 */
556     eecookiep -> toplabel = getlab();
557     putlab( eecookiep -> toplabel );
558     putprintf("	subl2	$%s%d,sp" , 0 , FRAME_SIZE_LABEL, ftnno );
559     if ( profflag ) {
560 	    /*
561 	     *	call mcount for profiling
562 	     */
563 	putprintf( "	moval	" , 1 );
564 	putprintf( PREFIXFORMAT , 1 , LABELPREFIX , proflabel );
565 	putprintf( ",r0" , 0 );
566 	putprintf( "	jsb	mcount" , 0 );
567 	putprintf( "	.data" , 0 );
568 	putprintf( "	.align	2" , 0 );
569 	putlab( proflabel );
570 	putprintf( "	.long	0" , 0 );
571 	putprintf( "	.text" , 0 );
572     }
573 	/*
574 	 *	if there are nested procedures that access our variables
575 	 *	we must save the display.
576 	 */
577     if ( parts[ cbn ] & NONLOCALVAR ) {
578 	    /*
579 	     *	save old display
580 	     */
581 	putprintf( "	movq	%s+%d,%d(%s)" , 0
582 		, DISPLAYNAME , cbn * sizeof(struct dispsave)
583 		, DSAVEOFFSET , P2FPNAME );
584 	    /*
585 	     *	set up new display by saving AP and FP in appropriate
586 	     *	slot in display structure.
587 	     */
588 	putprintf( "	movq	%s,%s+%d" , 0
589 		, P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) );
590     }
591 	/*
592 	 *	set underflow checking if runtime tests
593 	 */
594     if ( opt( 't' ) ) {
595 	putprintf( "	bispsw	$0xe0" , 0 );
596     }
597 	/*
598 	 *	zero local variables if checking is on
599 	 *	by calling blkclr( bytes of locals , starting local address );
600 	 */
601     if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
602 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
603 		, "_blkclr" );
604 	putLV( 0 , cbn , sizes[ cbn ].om_max , NLOCAL , P2CHAR );
605 	putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
606 		, 0 , P2INT , 0 );
607 	putop( P2LISTOP , P2INT );
608 	putop( P2CALL , P2INT );
609 	putdot( filename , line );
610     }
611 	/*
612 	 *  set up goto vector if non-local goto to this frame
613 	 */
614     if ( parts[ cbn ] & NONLOCALGOTO ) {
615 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
616 		, "_setjmp" );
617 	putLV( 0 , cbn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
618 	putop( P2CALL , P2INT );
619 	putleaf( P2ICON , 0 , 0 , P2INT , 0 );
620 	putop( P2NE , P2INT );
621 	putleaf( P2ICON , setjmp0 , 0 , P2INT , 0 );
622 	putop( P2CBRANCH , P2INT );
623 	putdot( filename , line );
624 	    /*
625 	     *	on non-local goto, setjmp returns with address to
626 	     *	be branched to.
627 	     */
628 	putprintf( "	jmp	(r0)" , 0 );
629 	putlab(setjmp0);
630     }
631 }
632 
633 fp_exitcode(eecookiep)
634     struct entry_exit_cookie	*eecookiep;
635 {
636 	/*
637 	 *	if there were file variables declared at this level
638 	 *	call PCLOSE( ap ) to clean them up.
639 	 */
640     if ( dfiles[ cbn ] ) {
641 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
642 		, "_PCLOSE" );
643 	putleaf( P2REG , 0 , P2AP , ADDTYPE( P2CHAR , P2PTR ) , 0 );
644 	putop( P2CALL , P2INT );
645 	putdot( filename , line );
646     }
647 	/*
648 	 *	if this is a function,
649 	 *	the function variable is the return value.
650 	 *	if it's a scalar valued function, return scalar,
651 	 *	else, return a pointer to the structure value.
652 	 */
653     if ( eecookiep-> nlp -> class == FUNC ) {
654 	struct nl	*fvar = eecookiep-> nlp -> ptr[ NL_FVAR ];
655 	long		fvartype = p2type( fvar -> type );
656 	long		label;
657 	char		labelname[ BUFSIZ ];
658 
659 	switch ( classify( fvar -> type ) ) {
660 	    case TBOOL:
661 	    case TCHAR:
662 	    case TINT:
663 	    case TSCAL:
664 	    case TDOUBLE:
665 	    case TPTR:
666 		putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
667 			fvar -> value[ NL_OFFS ] ,
668 			fvar -> extra_flags ,
669 			fvartype );
670 		break;
671 	    default:
672 		label = getlab();
673 		sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
674 		putprintf( "	.data" , 0 );
675 		aligndot(A_STRUCT);
676 		putprintf( "	.lcomm	%s,%d" , 0 ,
677 			    labelname , lwidth( fvar -> type ) );
678 		putprintf( "	.text" , 0 );
679 		putleaf( P2NAME , 0 , 0 , fvartype , labelname );
680 		putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
681 			fvar -> value[ NL_OFFS ] ,
682 			fvar -> extra_flags ,
683 			fvartype );
684 		putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
685 			align( fvar -> type ) );
686 		putdot( filename , line );
687 		putleaf( P2ICON , 0 , 0 , fvartype , labelname );
688 		break;
689 	}
690 	putop( P2FORCE , fvartype );
691 	putdot( filename , line );
692     }
693 	/*
694 	 *	if there are nested procedures we must save the display.
695 	 */
696     if ( parts[ cbn ] & NONLOCALVAR ) {
697 	    /*
698 	     *	restore old display entry from save area
699 	     */
700 	putprintf( "	movq	%d(%s),%s+%d" , 0
701 	    , DSAVEOFFSET , P2FPNAME
702 	    , DISPLAYNAME , cbn * sizeof(struct dispsave) );
703     }
704 }
705 
706 fp_epilogue(eecookiep)
707     struct entry_exit_cookie	*eecookiep;
708 {
709     putprintf("	ret" , 0 );
710 	/*
711 	 *	set the register save mask.
712 	 */
713     putprintf("	.set	%s%d,0x%x", 0,
714 		SAVE_MASK_LABEL, eecookiep -> savlabel, savmask());
715 }
716 
717 fp_formalentry(eecookiep)
718     struct entry_exit_cookie	*eecookiep;
719 {
720 
721     putprintf("%s%s:" , 0 , FORMALPREFIX , eecookiep -> extname );
722     putprintf("	.word	%s%d", 0, SAVE_MASK_LABEL, eecookiep -> savlabel );
723     putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_FCALL" );
724     putRV( 0 , cbn ,
725 	eecookiep -> nlp -> value[ NL_OFFS ] + sizeof( struct formalrtn * ) ,
726 	NPARAM , P2PTR | P2STRTY );
727     putRV(0, cbn, eecookiep -> nlp -> value[NL_OFFS], NPARAM, P2PTR|P2STRTY);
728     putop( P2LISTOP , P2INT );
729     putop( P2CALL , P2INT );
730     putdot( filename , line );
731     putjbr( eecookiep -> toplabel );
732 }
733 #endif vax
734 
735 #ifdef mc68000
736 
737 codeformain()
738 {
739     putprintf("	.text", 0);
740     putprintf("	.globl	_main", 0);
741     putprintf("_main:", 0);
742     putprintf("	link	%s,#0", 0, P2FPNAME);
743     if (opt('t')) {
744 	putprintf("	pea	1", 0);
745     } else {
746 	putprintf("	pea	0", 0);
747     }
748     putprintf("	jbsr	_PCSTART", 0);
749     putprintf("	addql	#4,sp", 0);
750     putprintf("	movl	%s@(8),__argc", 0, P2FPNAME);
751     putprintf("	movl	%s@(12),__argv", 0, P2FPNAME);
752     putprintf("	jbsr	_program", 0);
753     putprintf("	pea	0", 0);
754     putprintf("	jbsr	_PCEXIT", 0);
755 }
756 
757 prog_prologue(eecookiep)
758     struct entry_exit_cookie	*eecookiep;
759 {
760     int	ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
761 
762     putprintf("	.text", 0);
763     putprintf("	.globl	_program", 0);
764     putprintf("_program:", 0);
765     putprintf("	link	%s,#0", 0, P2FPNAME);
766     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
767 	/* touch new end of stack, to break more stack space */
768     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
769     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
770 }
771 
772 fp_prologue(eecookiep)
773     struct entry_exit_cookie	*eecookiep;
774 {
775     int		ftnno = eecookiep -> nlp -> value[NL_ENTLOC];
776 
777     sextname(eecookiep -> extname, eecookiep -> nlp -> symbol, cbn - 1);
778     putprintf("	.text", 0);
779     putprintf("	.globl	%s%s", 0, FORMALPREFIX, eecookiep -> extname);
780     putprintf("	.globl	%s", 0, eecookiep -> extname);
781     putprintf("%s:", 0, eecookiep -> extname);
782     putprintf("	link	%s,#0", 0, P2FPNAME);
783     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
784 	/* touch new end of stack, to break more stack space */
785     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
786     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
787 }
788 
789 fp_entrycode(eecookiep)
790     struct entry_exit_cookie	*eecookiep;
791 {
792     int	proflabel = getlab();
793     int	setjmp0 = getlab();
794 
795 	/*
796 	 *	fill in the label cookie
797 	 */
798     eecookiep -> toplabel = getlab();
799     putlab(eecookiep -> toplabel);
800 	/*
801 	 *	call mcount if we are profiling.
802 	 */
803     if ( profflag ) {
804 	putprintf("	movl	#%s%d,a0", 0, LABELPREFIX,  proflabel);
805 	putprintf("	jsr	mcount", 0);
806 	putprintf("	.data", 0);
807 	putprintf("	.even", 0);
808 	putlab(proflabel);
809 	putprintf("	.long	0", 0);
810 	putprintf("	.text", 0);
811     }
812 	/*
813 	 *	if there are nested procedures that access our variables
814 	 *	we must save the display
815 	 */
816     if (parts[cbn] & NONLOCALVAR) {
817 	    /*
818 	     *	save the old display
819 	     */
820 	putprintf("	movl	%s+%d,%s@(%d)", 0,
821 		    DISPLAYNAME, cbn * sizeof(struct dispsave),
822 		    P2FPNAME, DSAVEOFFSET);
823 	    /*
824 	     *	set up the new display by saving the framepointer
825 	     *	in the display structure.
826 	     */
827 	putprintf("	movl	%s,%s+%d", 0,
828 		    P2FPNAME, DISPLAYNAME, cbn * sizeof(struct dispsave));
829     }
830 	/*
831 	 *	zero local variables if checking is on
832 	 *	by calling blkclr( bytes of locals , starting local address );
833 	 */
834     if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
835 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
836 		, "_blkclr" );
837 	putLV( 0 , cbn , sizes[ cbn ].om_max , NLOCAL , P2CHAR );
838 	putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
839 		, 0 , P2INT , 0 );
840 	putop( P2LISTOP , P2INT );
841 	putop( P2CALL , P2INT );
842 	putdot( filename , line );
843     }
844 	/*
845 	 *  set up goto vector if non-local goto to this frame
846 	 */
847     if ( parts[ cbn ] & NONLOCALGOTO ) {
848 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
849 		, "_setjmp" );
850 	putLV( 0 , cbn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
851 	putop( P2CALL , P2INT );
852 	putleaf( P2ICON , 0 , 0 , P2INT , 0 );
853 	putop( P2NE , P2INT );
854 	putleaf( P2ICON , setjmp0 , 0 , P2INT , 0 );
855 	putop( P2CBRANCH , P2INT );
856 	putdot( filename , line );
857 	    /*
858 	     *	on non-local goto, setjmp returns with address to
859 	     *	be branched to.
860 	     */
861 	putprintf("	movl	d0,a0", 0);
862 	putprintf("	jmp	a0@", 0);
863 	putlab(setjmp0);
864     }
865 }
866 
867 fp_exitcode(eecookiep)
868     struct entry_exit_cookie	*eecookiep;
869 {
870 	/*
871 	 *	if there were file variables declared at this level
872 	 *	call PCLOSE( ap ) to clean them up.
873 	 */
874     if ( dfiles[ cbn ] ) {
875 	putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
876 		, "_PCLOSE" );
877 	putleaf( P2REG , 0 , P2AP , ADDTYPE( P2CHAR , P2PTR ) , 0 );
878 	putop( P2CALL , P2INT );
879 	putdot( filename , line );
880     }
881 	/*
882 	 *	if this is a function,
883 	 *	the function variable is the return value.
884 	 *	if it's a scalar valued function, return scalar,
885 	 *	else, return a pointer to the structure value.
886 	 */
887     if ( eecookiep -> nlp -> class == FUNC ) {
888 	struct nl	*fvar = eecookiep -> nlp -> ptr[ NL_FVAR ];
889 	long		fvartype = p2type( fvar -> type );
890 	long		label;
891 	char		labelname[ BUFSIZ ];
892 
893 	switch ( classify( fvar -> type ) ) {
894 	    case TBOOL:
895 	    case TCHAR:
896 	    case TINT:
897 	    case TSCAL:
898 	    case TDOUBLE:
899 	    case TPTR:
900 		putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
901 			fvar -> value[ NL_OFFS ] ,
902 			fvar -> extra_flags ,
903 			fvartype );
904 		break;
905 	    default:
906 		label = getlab();
907 		sprintf( labelname , PREFIXFORMAT , LABELPREFIX , label );
908 		putprintf("	.lcomm	%s,%d", 0,
909 			labelname, lwidth(fvar -> type));
910 		putleaf( P2NAME , 0 , 0 , fvartype , labelname );
911 		putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 ,
912 			fvar -> value[ NL_OFFS ] ,
913 			fvar -> extra_flags ,
914 			fvartype );
915 		putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
916 			align( fvar -> type ) );
917 		putdot( filename , line );
918 		putleaf( P2ICON , 0 , 0 , fvartype , labelname );
919 		break;
920 	}
921 	putop( P2FORCE , fvartype );
922 	putdot( filename , line );
923     }
924 	/*
925 	 *	if we saved a display, we must restore it.
926 	 */
927     if ( parts[ cbn ] & NONLOCALVAR ) {
928 	    /*
929 	     *	restore old display entry from save area
930 	     */
931 	putprintf("	movl	%s@(%d),%s+%d", 0,
932 		    P2FPNAME, DSAVEOFFSET,
933 		    DISPLAYNAME, cbn * sizeof(struct dispsave));
934     }
935 }
936 
937 fp_epilogue(eecookiep)
938     struct entry_exit_cookie	*eecookiep;
939 {
940     /*
941      *	all done by the second pass.
942      */
943 }
944 
945 fp_formalentry(eecookiep)
946     struct entry_exit_cookie	*eecookiep;
947 {
948     putprintf( "%s%s:" , 0 , FORMALPREFIX , eecookiep -> extname );
949     putprintf("	link	%s,#0", 0, P2FPNAME);
950     putprintf("	addl	#-%s%d,sp", 0, FRAME_SIZE_LABEL, ftnno);
951 	/* touch new end of stack, to break more stack space */
952     putprintf("	tstb	sp@(-%s%d)", 0, PAGE_BREAK_LABEL, ftnno);
953     putprintf("	moveml	#%s%d,sp@", 0, SAVE_MASK_LABEL, ftnno);
954     putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_FCALL" );
955     putRV( 0 , cbn ,
956 	eecookiep -> nlp -> value[ NL_OFFS ] + sizeof( struct formalrtn * ) ,
957 	NPARAM , P2PTR | P2STRTY );
958     putRV(0, cbn, eecookiep -> nlp -> value[NL_OFFS], NPARAM, P2PTR|P2STRTY);
959     putop( P2LISTOP , P2INT );
960     putop( P2CALL , P2INT );
961     putdot( filename , line );
962     putjbr( eecookiep -> toplabel );
963 }
964 #endif mc68000
965 #endif PC
966