xref: /csrg-svn/usr.bin/pascal/src/fend.c (revision 3192)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fend.c 1.1 03/11/81";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "tree.h"
8 #include "opcode.h"
9 #include "objfmt.h"
10 #include "align.h"
11 
12 /*
13  * this array keeps the pxp counters associated with
14  * functions and procedures, so that they can be output
15  * when their bodies are encountered
16  */
17 int	bodycnts[ DSPLYSZ ];
18 
19 #ifdef PC
20 #   include "pc.h"
21 #   include "pcops.h"
22 #endif PC
23 
24 #ifdef OBJ
25 int	cntpatch;
26 int	nfppatch;
27 #endif OBJ
28 
29 struct	nl *Fp;
30 int	pnumcnt;
31 /*
32  * Funcend is called to
33  * finish a block by generating
34  * the code for the statements.
35  * It then looks for unresolved declarations
36  * of labels, procedures and functions,
37  * and cleans up the name list.
38  * For the program, it checks the
39  * semantics of the program
40  * statement (yuchh).
41  */
42 funcend(fp, bundle, endline)
43 	struct nl *fp;
44 	int *bundle;
45 	int endline;
46 {
47 	register struct nl *p;
48 	register int i, b;
49 	int var, inp, out, *blk;
50 	bool chkref;
51 	struct nl *iop;
52 	char *cp;
53 	extern int cntstat;
54 #	ifdef PC
55 	    int	toplabel = getlab();
56 	    int	botlabel = getlab();
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->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 	if ( fp -> class == PROG ) {
115 	    putprintf( "	.text" , 0 );
116 	    putprintf( "	.align	1" , 0 );
117 	    putprintf( "	.globl	_main" , 0 );
118 	    putprintf( "_main:" , 0 );
119 	    putprintf( "	.word	0" , 0 );
120 	    putprintf( "	calls	$0,_PCSTART" , 0 );
121 	    putprintf( "	movl	4(ap),__argc" , 0 );
122 	    putprintf( "	movl	8(ap),__argv" , 0 );
123 	    putprintf( "	calls	$0,_program" , 0 );
124 	    putprintf( "	calls	$0,_PCEXIT" , 0 );
125 	    ftnno = fp -> entloc;
126 	    putprintf( "	.text" , 0 );
127 	    putprintf( "	.align	1" , 0 );
128 	    putprintf( "	.globl	_program" , 0 );
129 	    putprintf( "_program:" , 0 );
130 	    stabfunc( "program" , fp -> class , bundle[1] , 0 );
131 	} else {
132 	    ftnno = fp -> entloc;
133 	    putprintf( "	.text" , 0 );
134 	    putprintf( "	.align	1" , 0 );
135 	    putprintf( "	.globl	" , 1 );
136 	    for ( i = 1 ; i < cbn ; i++ ) {
137 		putprintf( EXTFORMAT , 1 , enclosing[ i ] );
138 	    }
139 	    putprintf( "" , 0 );
140 	    for ( i = 1 ; i < cbn ; i++ ) {
141 		putprintf( EXTFORMAT , 1 , enclosing[ i ] );
142 	    }
143 	    putprintf( ":" , 0 );
144 	    stabfunc( fp -> symbol , fp -> class , bundle[1] , cbn - 1 );
145 	    for ( p = fp -> chain ; p != NIL ; p = p -> chain ) {
146 		stabparam( p -> symbol , p2type( p -> type )
147 			    , p -> value[ NL_OFFS ] , 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 ] , 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 ] , lwidth( p -> type ) );
175 		    }
176 		}
177 	    }
178 	}
179 	stablbrac( cbn );
180 	    /*
181 	     *	register save mask
182 	     */
183 	if ( opt( 't' ) ) {
184 	    putprintf( "	.word	0x%x" , 0 , RUNCHECK | RSAVEMASK );
185 	} else {
186 	    putprintf( "	.word	0x%x" , 0 , RSAVEMASK );
187 	}
188 	putjbr( botlabel );
189 	putlab( toplabel );
190 	if ( profflag ) {
191 		/*
192 		 *	call mcount for profiling
193 		 */
194 	    putprintf( "	moval	1f,r0" , 0 );
195 	    putprintf( "	jsb	mcount" , 0 );
196 	    putprintf( "	.data" , 0 );
197 	    putprintf( "	.align	2" , 0 );
198 	    putprintf( "1:" , 0 );
199 	    putprintf( "	.long	0" , 0 );
200 	    putprintf( "	.text" , 0 );
201 	}
202 	    /*
203 	     *	set up unwind exception vector.
204 	     */
205 	putprintf( "	moval	%s,%d(%s)" , 0
206 		, UNWINDNAME , UNWINDOFFSET , P2FPNAME );
207 	    /*
208 	     *	save address of display entry, for unwind.
209 	     */
210 	putprintf( "	moval	%s+%d,%d(%s)" , 0
211 		, DISPLAYNAME , cbn * sizeof(struct dispsave)
212 		, DPTROFFSET , P2FPNAME );
213 	    /*
214 	     *	save old display
215 	     */
216 	putprintf( "	movq	%s+%d,%d(%s)" , 0
217 		, DISPLAYNAME , cbn * sizeof(struct dispsave)
218 		, DSAVEOFFSET , P2FPNAME );
219 	    /*
220 	     *	set up new display by saving AP and FP in appropriate
221 	     *	slot in display structure.
222 	     */
223 	putprintf( "	movq	%s,%s+%d" , 0
224 		, P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) );
225 	    /*
226 	     *	ask second pass to allocate known locals
227 	     */
228 	putlbracket( ftnno , -sizes[ cbn ].om_max );
229 	    /*
230 	     *	and zero them if checking is on
231 	     *	by calling blkclr( bytes of locals , starting local address );
232 	     */
233 	if ( opt( 't' ) ) {
234 	    if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
235 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
236 			, "_blkclr" );
237 		putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
238 			, 0 , P2INT , 0 );
239 		putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
240 		putop( P2LISTOP , P2INT );
241 		putop( P2CALL , P2INT );
242 		putdot( filename , line );
243 	    }
244 		/*
245 		 *  check number of longs of arguments
246 		 *  this can only be wrong for formal calls.
247 		 */
248 	    if ( fp -> class != PROG ) {
249 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) ,
250 			    "_NARGCHK" );
251 		    putleaf( P2ICON ,
252 			(fp->value[NL_OFFS] - DPOFF2) / sizeof(long) ,
253 			0 , P2INT , 0 );
254 		    putop( P2CALL , P2INT );
255 		    putdot( filename , line );
256 	    }
257 	}
258 #endif PC
259 	if ( monflg ) {
260 		if ( fp -> value[ NL_CNTR ] != 0 ) {
261 			inccnt( fp -> value [ NL_CNTR ] );
262 		}
263 		inccnt( bodycnts[ fp -> nl_block & 037 ] );
264 	}
265 	if (fp->class == PROG) {
266 		/*
267 		 * The glorious buffers option.
268 		 *          0 = don't buffer output
269 		 *          1 = line buffer output
270 		 *          2 = 512 byte buffer output
271 		 */
272 #		ifdef OBJ
273 		    if (opt('b') != 1)
274 			    put(1, O_BUFF | opt('b') << 8);
275 #		endif OBJ
276 #		ifdef PC
277 		    if ( opt( 'b' ) != 1 ) {
278 			putleaf( P2ICON , 0 , 0
279 				, ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" );
280 			putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 );
281 			putop( P2CALL , P2INT );
282 			putdot( filename , line );
283 		    }
284 #		endif PC
285 		out = 0;
286 		for (p = fp->chain; p != NIL; p = p->chain) {
287 			if (strcmp(p->symbol, "input") == 0) {
288 				inp++;
289 				continue;
290 			}
291 			if (strcmp(p->symbol, "output") == 0) {
292 				out++;
293 				continue;
294 			}
295 			iop = lookup1(p->symbol);
296 			if (iop == NIL || bn != cbn) {
297 				error("File %s listed in program statement but not declared", p->symbol);
298 				continue;
299 			}
300 			if (iop->class != VAR) {
301 				error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
302 				continue;
303 			}
304 			if (iop->type == NIL)
305 				continue;
306 			if (iop->type->class != FILET) {
307 				error("File %s listed in program statement but defined as %s",
308 					p->symbol, nameof(iop->type));
309 				continue;
310 			}
311 #			ifdef OBJ
312 			    put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type));
313 			    i = lenstr(p->symbol,0);
314 			    put(2, O_CON24, i);
315 			    put(2, O_LVCON, i);
316 			    putstr(p->symbol, 0);
317 			    put(2, O_LV | bn<<8+INDX, (int)iop->value[NL_OFFS]);
318 			    put(1, O_DEFNAME);
319 #			endif OBJ
320 #			ifdef PC
321 			    putleaf( P2ICON , 0 , 0
322 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
323 				    , "_DEFNAME" );
324 			    putLV( p -> symbol , bn , iop -> value[NL_OFFS]
325 				    , p2type( iop ) );
326 			    putCONG( p -> symbol , strlen( p -> symbol )
327 				    , LREQ );
328 			    putop( P2LISTOP , P2INT );
329 			    putleaf( P2ICON , strlen( p -> symbol )
330 				    , 0 , P2INT , 0 );
331 			    putop( P2LISTOP , P2INT );
332 			    putleaf( P2ICON
333 				, text(iop->type) ? 0 : width(iop->type->type)
334 				, 0 , P2INT , 0 );
335 			    putop( P2LISTOP , P2INT );
336 			    putop( P2CALL , P2INT );
337 			    putdot( filename , line );
338 #			endif PC
339 		}
340 		if (out == 0 && fp->chain != NIL) {
341 			recovered();
342 			error("The file output must appear in the program statement file list");
343 		}
344 	}
345 	/*
346 	 * Process the prog/proc/func body
347 	 */
348 	noreach = 0;
349 	line = bundle[1];
350 	statlist(blk);
351 #	ifdef PTREE
352 	    {
353 		pPointer Body = tCopy( blk );
354 
355 		pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
356 	    }
357 #	endif PTREE
358 #	ifdef OBJ
359 	    if (cbn== 1 && monflg != 0) {
360 		    patchfil(cntpatch - 2, (long)cnts, 2);
361 		    patchfil(nfppatch - 2, (long)pfcnt, 2);
362 	    }
363 #	endif OBJ
364 #	ifdef PC
365 	    if ( fp -> class == PROG && monflg ) {
366 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
367 			, "_PMFLUSH" );
368 		putleaf( P2ICON , cnts , 0 , P2INT , 0 );
369 		putleaf( P2ICON , pfcnt , 0 , P2INT , 0 );
370 		putop( P2LISTOP , P2INT );
371 		putLV( PCPCOUNT , 0 , 0 , P2INT );
372 		putop( P2LISTOP , P2INT );
373 		putop( P2CALL , P2INT );
374 		putdot( filename , line );
375 	    }
376 #	endif PC
377 	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
378 		recovered();
379 		error("Input is used but not defined in the program statement");
380 	}
381 	/*
382 	 * Clean up the symbol table displays and check for unresolves
383 	 */
384 	line = endline;
385 	b = cbn;
386 	Fp = fp;
387 	chkref = syneflg == errcnt[cbn] && opt('w') == 0;
388 	for (i = 0; i <= 077; i++) {
389 		for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
390 			/*
391 			 * Check for variables defined
392 			 * but not referenced
393 			 */
394 			if (chkref && p->symbol != NIL)
395 			switch (p->class) {
396 				case FIELD:
397 					/*
398 					 * If the corresponding record is
399 					 * unused, we shouldn't complain about
400 					 * the fields.
401 					 */
402 				default:
403 					if ((p->nl_flags & (NUSED|NMOD)) == 0) {
404 						warning();
405 						nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
406 						break;
407 					}
408 					/*
409 					 * If a var parameter is either
410 					 * modified or used that is enough.
411 					 */
412 					if (p->class == REF)
413 						continue;
414 #					ifdef OBJ
415 					    if ((p->nl_flags & NUSED) == 0) {
416 						warning();
417 						nerror("%s %s is never used", classes[p->class], p->symbol);
418 						break;
419 					    }
420 #					endif OBJ
421 #					ifdef PC
422 					    if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) {
423 						warning();
424 						nerror("%s %s is never used", classes[p->class], p->symbol);
425 						break;
426 					    }
427 #					endif PC
428 					if ((p->nl_flags & NMOD) == 0) {
429 						warning();
430 						nerror("%s %s is used but never set", classes[p->class], p->symbol);
431 						break;
432 					}
433 				case LABEL:
434 				case FVAR:
435 				case BADUSE:
436 					break;
437 			}
438 			switch (p->class) {
439 				case BADUSE:
440 					cp = "s";
441 					if (p->chain->ud_next == NIL)
442 						cp++;
443 					eholdnl();
444 					if (p->value[NL_KINDS] & ISUNDEF)
445 						nerror("%s undefined on line%s", p->symbol, cp);
446 					else
447 						nerror("%s improperly used on line%s", p->symbol, cp);
448 					pnumcnt = 10;
449 					pnums(p->chain);
450 					pchr('\n');
451 					break;
452 
453 				case FUNC:
454 				case PROC:
455 #					ifdef OBJ
456 					    if ((p->nl_flags & NFORWD))
457 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
458 #					endif OBJ
459 #					ifdef PC
460 					    if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
461 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
462 #					endif PC
463 					break;
464 
465 				case LABEL:
466 					if (p->nl_flags & NFORWD)
467 						nerror("label %s was declared but not defined", p->symbol);
468 					break;
469 				case FVAR:
470 					if ((p->nl_flags & NMOD) == 0)
471 						nerror("No assignment to the function variable");
472 					break;
473 			}
474 		}
475 		/*
476 		 * Pop this symbol
477 		 * table slot
478 		 */
479 		disptab[i] = p;
480 	}
481 
482 #	ifdef OBJ
483 	    put(1, O_END);
484 #	endif OBJ
485 #	ifdef PC
486 		/*
487 		 *	if there were file variables declared at this level
488 		 *	call pclose( &__disply[ cbn ] ) to clean them up.
489 		 */
490 	    if ( dfiles[ cbn ] ) {
491 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
492 			, "_PCLOSE" );
493 		putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave )
494 			, P2PTR | P2CHAR );
495 		putop( P2CALL , P2INT );
496 		putdot( filename , line );
497 	    }
498 		/*
499 		 *	if this is a function,
500 		 *	the function variable is the return value.
501 		 *	if it's a scalar valued function, return scalar,
502 		 *	else, return a pointer to the structure value.
503 		 */
504 	    if ( fp -> class == FUNC ) {
505 		struct nl	*fvar = fp -> ptr[ NL_FVAR ];
506 		long		fvartype = p2type( fvar -> type );
507 		long		label;
508 		char		labelname[ BUFSIZ ];
509 
510 		switch ( classify( fvar -> type ) ) {
511 		    case TBOOL:
512 		    case TCHAR:
513 		    case TINT:
514 		    case TSCAL:
515 		    case TDOUBLE:
516 		    case TPTR:
517 			putRV( fvar -> symbol , ( fvar -> nl_block ) & 037
518 				, fvar -> value[ NL_OFFS ] , fvartype );
519 			break;
520 		    default:
521 			label = getlab();
522 			sprintf( labelname , PREFIXFORMAT ,
523 				LABELPREFIX , label );
524 			putprintf( "	.data" , 0 );
525 			putprintf( "	.lcomm	%s,%d" , 0 ,
526 				    labelname , lwidth( fvar -> type ) );
527 			putprintf( "	.text" , 0 );
528 			putleaf( P2NAME , 0 , 0 , fvartype , labelname );
529 			putLV( fvar -> symbol , ( fvar -> nl_block ) & 037
530 				, fvar -> value[ NL_OFFS ] , fvartype );
531 			putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
532 				align( fvar -> type ) );
533 			putdot( filename , line );
534 			putleaf( P2ICON , 0 , 0 , fvartype , labelname );
535 			break;
536 		}
537 		putop( P2FORCE , fvartype );
538 		putdot( filename , line );
539 	    }
540 		/*
541 		 *	restore old display entry from save area
542 		 */
543 
544 	    putprintf( "	movq	%d(%s),%s+%d" , 0
545 		, DSAVEOFFSET , P2FPNAME
546 		, DISPLAYNAME , cbn * sizeof(struct dispsave) );
547 	    stabrbrac( cbn );
548 	    putprintf( "	ret" , 0 );
549 		/*
550 		 *	let the second pass allocate locals
551 		 */
552 	    putlab( botlabel );
553 	    putprintf( "	subl2	$LF%d,sp" , 0 , ftnno );
554 	    putrbracket( ftnno );
555 	    putjbr( toplabel );
556 		/*
557 		 *	declare pcp counters, if any
558 		 */
559 	    if ( monflg && fp -> class == PROG ) {
560 		putprintf( "	.data" , 0 );
561 		putprintf( "	.comm	" , 1 );
562 		putprintf( PCPCOUNT , 1 );
563 		putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) );
564 		putprintf( "	.text" , 0 );
565 	    }
566 #	endif PC
567 #ifdef DEBUG
568 	dumpnl(fp->ptr[2], fp->symbol);
569 #endif
570 	/*
571 	 * Restore the
572 	 * (virtual) name list
573 	 * position
574 	 */
575 	nlfree(fp->ptr[2]);
576 	/*
577 	 * Proc/func has been
578 	 * resolved
579 	 */
580 	fp->nl_flags &= ~NFORWD;
581 	/*
582 	 * Patch the beg
583 	 * of the proc/func to
584 	 * the proper variable size
585 	 */
586 	if (Fp == NIL)
587 		elineon();
588 #	ifdef OBJ
589 	    patchfil(var, (long)(-sizes[cbn].om_max), 2);
590 #	endif OBJ
591 	cbn--;
592 	if (inpflist(fp->symbol)) {
593 		opop('l');
594 	}
595 }
596