xref: /csrg-svn/usr.bin/pascal/src/fend.c (revision 3279)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)fend.c 1.2 03/16/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	savlabel = getlab();
56 	    int	toplabel = getlab();
57 	    int	botlabel = getlab();
58 #	endif PC
59 
60 	cntstat = 0;
61 /*
62  *	yyoutline();
63  */
64 	if (program != NIL)
65 		line = program->value[3];
66 	blk = bundle[2];
67 	if (fp == NIL) {
68 		cbn--;
69 #		ifdef PTREE
70 		    nesting--;
71 #		endif PTREE
72 		return;
73 	}
74 #ifdef OBJ
75 	/*
76 	 * Patch the branch to the
77 	 * entry point of the function
78 	 */
79 	patch4(fp->entloc);
80 	/*
81 	 * Put out the block entrance code and the block name.
82 	 * HDRSZE is the number of bytes of info in the static
83 	 * BEG data area exclusive of the proc name. It is
84 	 * currently defined as:
85 	/*	struct hdr {
86 	/*		long framesze;	/* number of bytes of local vars */
87 	/*		long nargs;	/* number of bytes of arguments */
88 	/*		bool tests;	/* TRUE => perform runtime tests */
89 	/*		short offset;	/* offset of procedure in source file */
90 	/*		char name[1];	/* name of active procedure */
91 	/*	};
92 	 */
93 #	define HDRSZE (2 * sizeof(long) + sizeof(short) + sizeof(bool))
94 	var = put(2, ((lenstr(fp->symbol,0) + HDRSZE) << 8)
95 		| (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), (long)0);
96 	    /*
97 	     *  output the number of bytes of arguments
98 	     *  this is only checked on formal calls.
99 	     */
100 	put(2, O_CASE4, cbn == 1 ? (long)0 : (long)(fp->value[NL_OFFS]-DPOFF2));
101 	    /*
102 	     *	Output the runtime test mode for the routine
103 	     */
104 	put(2, sizeof(bool) == 2 ? O_CASE2 : O_CASE4, opt('t') ? TRUE : FALSE);
105 	    /*
106 	     *	Output line number and routine name
107 	     */
108 	put(2, O_CASE2, bundle[1]);
109 	putstr(fp->symbol, 0);
110 #endif OBJ
111 #ifdef PC
112 	/*
113 	 * put out the procedure entry code
114 	 */
115 	if ( fp -> class == PROG ) {
116 	    putprintf( "	.text" , 0 );
117 	    putprintf( "	.align	1" , 0 );
118 	    putprintf( "	.globl	_main" , 0 );
119 	    putprintf( "_main:" , 0 );
120 	    putprintf( "	.word	0" , 0 );
121 	    putprintf( "	calls	$0,_PCSTART" , 0 );
122 	    putprintf( "	movl	4(ap),__argc" , 0 );
123 	    putprintf( "	movl	8(ap),__argv" , 0 );
124 	    putprintf( "	calls	$0,_program" , 0 );
125 	    putprintf( "	calls	$0,_PCEXIT" , 0 );
126 	    ftnno = fp -> entloc;
127 	    putprintf( "	.text" , 0 );
128 	    putprintf( "	.align	1" , 0 );
129 	    putprintf( "	.globl	_program" , 0 );
130 	    putprintf( "_program:" , 0 );
131 	    stabfunc( "program" , fp -> class , bundle[1] , 0 );
132 	} else {
133 	    ftnno = fp -> entloc;
134 	    putprintf( "	.text" , 0 );
135 	    putprintf( "	.align	1" , 0 );
136 	    putprintf( "	.globl	" , 1 );
137 	    for ( i = 1 ; i < cbn ; i++ ) {
138 		putprintf( EXTFORMAT , 1 , enclosing[ i ] );
139 	    }
140 	    putprintf( "" , 0 );
141 	    for ( i = 1 ; i < cbn ; i++ ) {
142 		putprintf( EXTFORMAT , 1 , enclosing[ i ] );
143 	    }
144 	    putprintf( ":" , 0 );
145 	    stabfunc( fp -> symbol , fp -> class , bundle[1] , cbn - 1 );
146 	    for ( p = fp -> chain ; p != NIL ; p = p -> chain ) {
147 		stabparam( p -> symbol , p2type( p -> type )
148 			    , p -> value[ NL_OFFS ] , lwidth( p -> type ) );
149 	    }
150 	    if ( fp -> class == FUNC ) {
151 		    /*
152 		     *	stab the function variable
153 		     */
154 		p = fp -> ptr[ NL_FVAR ];
155 		stablvar( p -> symbol , p2type( p -> type ) , cbn
156 			, p -> value[ NL_OFFS ] , lwidth( p -> type ) );
157 	    }
158 		/*
159 		 *	stab local variables
160 		 *	rummage down hash chain links.
161 		 */
162 	    for ( i = 0 ; i <= 077 ; i++ ) {
163 		for ( p = disptab[ i ] ; p != NIL ; p = p->nl_next) {
164 		    if ( ( p -> nl_block & 037 ) != cbn ) {
165 			break;
166 		    }
167 		    /*
168 		     *	stab local variables
169 		     *	that's named variables, but not params
170 		     */
171 		    if (   ( p -> symbol != NIL )
172 			&& ( p -> class == VAR )
173 			&& ( p -> value[ NL_OFFS ] < 0 ) ) {
174 			stablvar( p -> symbol , p2type( p -> type ) , cbn
175 			    , p -> value[ NL_OFFS ] , lwidth( p -> type ) );
176 		    }
177 		}
178 	    }
179 	}
180 	stablbrac( cbn );
181 	    /*
182 	     *	register save mask
183 	     */
184 	putprintf( "	.word	" , 1 );
185         putprintf( PREFIXFORMAT , 0 , LABELPREFIX , savlabel );
186 	putjbr( botlabel );
187 	putlab( toplabel );
188 	if ( profflag ) {
189 		/*
190 		 *	call mcount for profiling
191 		 */
192 	    putprintf( "	moval	1f,r0" , 0 );
193 	    putprintf( "	jsb	mcount" , 0 );
194 	    putprintf( "	.data" , 0 );
195 	    putprintf( "	.align	2" , 0 );
196 	    putprintf( "1:" , 0 );
197 	    putprintf( "	.long	0" , 0 );
198 	    putprintf( "	.text" , 0 );
199 	}
200 	    /*
201 	     *	set up unwind exception vector.
202 	     */
203 	putprintf( "	moval	%s,%d(%s)" , 0
204 		, UNWINDNAME , UNWINDOFFSET , P2FPNAME );
205 	    /*
206 	     *	save address of display entry, for unwind.
207 	     */
208 	putprintf( "	moval	%s+%d,%d(%s)" , 0
209 		, DISPLAYNAME , cbn * sizeof(struct dispsave)
210 		, DPTROFFSET , P2FPNAME );
211 	    /*
212 	     *	save old display
213 	     */
214 	putprintf( "	movq	%s+%d,%d(%s)" , 0
215 		, DISPLAYNAME , cbn * sizeof(struct dispsave)
216 		, DSAVEOFFSET , P2FPNAME );
217 	    /*
218 	     *	set up new display by saving AP and FP in appropriate
219 	     *	slot in display structure.
220 	     */
221 	putprintf( "	movq	%s,%s+%d" , 0
222 		, P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) );
223 	    /*
224 	     *	ask second pass to allocate known locals
225 	     */
226 	putlbracket( ftnno , -sizes[ cbn ].om_max );
227 	    /*
228 	     *	and zero them if checking is on
229 	     *	by calling blkclr( bytes of locals , starting local address );
230 	     */
231 	if ( opt( 't' ) ) {
232 	    if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
233 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
234 			, "_blkclr" );
235 		putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
236 			, 0 , P2INT , 0 );
237 		putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
238 		putop( P2LISTOP , P2INT );
239 		putop( P2CALL , P2INT );
240 		putdot( filename , line );
241 	    }
242 		/*
243 		 *  check number of longs of arguments
244 		 *  this can only be wrong for formal calls.
245 		 */
246 	    if ( fp -> class != PROG ) {
247 		    putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) ,
248 			    "_NARGCHK" );
249 		    putleaf( P2ICON ,
250 			(fp->value[NL_OFFS] - DPOFF2) / sizeof(long) ,
251 			0 , P2INT , 0 );
252 		    putop( P2CALL , P2INT );
253 		    putdot( filename , line );
254 	    }
255 	}
256 #endif PC
257 	if ( monflg ) {
258 		if ( fp -> value[ NL_CNTR ] != 0 ) {
259 			inccnt( fp -> value [ NL_CNTR ] );
260 		}
261 		inccnt( bodycnts[ fp -> nl_block & 037 ] );
262 	}
263 	if (fp->class == PROG) {
264 		/*
265 		 * The glorious buffers option.
266 		 *          0 = don't buffer output
267 		 *          1 = line buffer output
268 		 *          2 = 512 byte buffer output
269 		 */
270 #		ifdef OBJ
271 		    if (opt('b') != 1)
272 			    put(1, O_BUFF | opt('b') << 8);
273 #		endif OBJ
274 #		ifdef PC
275 		    if ( opt( 'b' ) != 1 ) {
276 			putleaf( P2ICON , 0 , 0
277 				, ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" );
278 			putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 );
279 			putop( P2CALL , P2INT );
280 			putdot( filename , line );
281 		    }
282 #		endif PC
283 		out = 0;
284 		for (p = fp->chain; p != NIL; p = p->chain) {
285 			if (strcmp(p->symbol, "input") == 0) {
286 				inp++;
287 				continue;
288 			}
289 			if (strcmp(p->symbol, "output") == 0) {
290 				out++;
291 				continue;
292 			}
293 			iop = lookup1(p->symbol);
294 			if (iop == NIL || bn != cbn) {
295 				error("File %s listed in program statement but not declared", p->symbol);
296 				continue;
297 			}
298 			if (iop->class != VAR) {
299 				error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
300 				continue;
301 			}
302 			if (iop->type == NIL)
303 				continue;
304 			if (iop->type->class != FILET) {
305 				error("File %s listed in program statement but defined as %s",
306 					p->symbol, nameof(iop->type));
307 				continue;
308 			}
309 #			ifdef OBJ
310 			    put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type));
311 			    i = lenstr(p->symbol,0);
312 			    put(2, O_CON24, i);
313 			    put(2, O_LVCON, i);
314 			    putstr(p->symbol, 0);
315 			    put(2, O_LV | bn<<8+INDX, (int)iop->value[NL_OFFS]);
316 			    put(1, O_DEFNAME);
317 #			endif OBJ
318 #			ifdef PC
319 			    putleaf( P2ICON , 0 , 0
320 				    , ADDTYPE( P2FTN | P2INT , P2PTR )
321 				    , "_DEFNAME" );
322 			    putLV( p -> symbol , bn , iop -> value[NL_OFFS]
323 				    , p2type( iop ) );
324 			    putCONG( p -> symbol , strlen( p -> symbol )
325 				    , LREQ );
326 			    putop( P2LISTOP , P2INT );
327 			    putleaf( P2ICON , strlen( p -> symbol )
328 				    , 0 , P2INT , 0 );
329 			    putop( P2LISTOP , P2INT );
330 			    putleaf( P2ICON
331 				, text(iop->type) ? 0 : width(iop->type->type)
332 				, 0 , P2INT , 0 );
333 			    putop( P2LISTOP , P2INT );
334 			    putop( P2CALL , P2INT );
335 			    putdot( filename , line );
336 #			endif PC
337 		}
338 		if (out == 0 && fp->chain != NIL) {
339 			recovered();
340 			error("The file output must appear in the program statement file list");
341 		}
342 	}
343 	/*
344 	 * Process the prog/proc/func body
345 	 */
346 	noreach = 0;
347 	line = bundle[1];
348 	statlist(blk);
349 #	ifdef PTREE
350 	    {
351 		pPointer Body = tCopy( blk );
352 
353 		pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body;
354 	    }
355 #	endif PTREE
356 #	ifdef OBJ
357 	    if (cbn== 1 && monflg != 0) {
358 		    patchfil(cntpatch - 2, (long)cnts, 2);
359 		    patchfil(nfppatch - 2, (long)pfcnt, 2);
360 	    }
361 #	endif OBJ
362 #	ifdef PC
363 	    if ( fp -> class == PROG && monflg ) {
364 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
365 			, "_PMFLUSH" );
366 		putleaf( P2ICON , cnts , 0 , P2INT , 0 );
367 		putleaf( P2ICON , pfcnt , 0 , P2INT , 0 );
368 		putop( P2LISTOP , P2INT );
369 		putLV( PCPCOUNT , 0 , 0 , P2INT );
370 		putop( P2LISTOP , P2INT );
371 		putop( P2CALL , P2INT );
372 		putdot( filename , line );
373 	    }
374 #	endif PC
375 	if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
376 		recovered();
377 		error("Input is used but not defined in the program statement");
378 	}
379 	/*
380 	 * Clean up the symbol table displays and check for unresolves
381 	 */
382 	line = endline;
383 	b = cbn;
384 	Fp = fp;
385 	chkref = syneflg == errcnt[cbn] && opt('w') == 0;
386 	for (i = 0; i <= 077; i++) {
387 		for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
388 			/*
389 			 * Check for variables defined
390 			 * but not referenced
391 			 */
392 			if (chkref && p->symbol != NIL)
393 			switch (p->class) {
394 				case FIELD:
395 					/*
396 					 * If the corresponding record is
397 					 * unused, we shouldn't complain about
398 					 * the fields.
399 					 */
400 				default:
401 					if ((p->nl_flags & (NUSED|NMOD)) == 0) {
402 						warning();
403 						nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
404 						break;
405 					}
406 					/*
407 					 * If a var parameter is either
408 					 * modified or used that is enough.
409 					 */
410 					if (p->class == REF)
411 						continue;
412 #					ifdef OBJ
413 					    if ((p->nl_flags & NUSED) == 0) {
414 						warning();
415 						nerror("%s %s is never used", classes[p->class], p->symbol);
416 						break;
417 					    }
418 #					endif OBJ
419 #					ifdef PC
420 					    if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) {
421 						warning();
422 						nerror("%s %s is never used", classes[p->class], p->symbol);
423 						break;
424 					    }
425 #					endif PC
426 					if ((p->nl_flags & NMOD) == 0) {
427 						warning();
428 						nerror("%s %s is used but never set", classes[p->class], p->symbol);
429 						break;
430 					}
431 				case LABEL:
432 				case FVAR:
433 				case BADUSE:
434 					break;
435 			}
436 			switch (p->class) {
437 				case BADUSE:
438 					cp = "s";
439 					if (p->chain->ud_next == NIL)
440 						cp++;
441 					eholdnl();
442 					if (p->value[NL_KINDS] & ISUNDEF)
443 						nerror("%s undefined on line%s", p->symbol, cp);
444 					else
445 						nerror("%s improperly used on line%s", p->symbol, cp);
446 					pnumcnt = 10;
447 					pnums(p->chain);
448 					pchr('\n');
449 					break;
450 
451 				case FUNC:
452 				case PROC:
453 #					ifdef OBJ
454 					    if ((p->nl_flags & NFORWD))
455 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
456 #					endif OBJ
457 #					ifdef PC
458 					    if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0))
459 						nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
460 #					endif PC
461 					break;
462 
463 				case LABEL:
464 					if (p->nl_flags & NFORWD)
465 						nerror("label %s was declared but not defined", p->symbol);
466 					break;
467 				case FVAR:
468 					if ((p->nl_flags & NMOD) == 0)
469 						nerror("No assignment to the function variable");
470 					break;
471 			}
472 		}
473 		/*
474 		 * Pop this symbol
475 		 * table slot
476 		 */
477 		disptab[i] = p;
478 	}
479 
480 #	ifdef OBJ
481 	    put(1, O_END);
482 #	endif OBJ
483 #	ifdef PC
484 		/*
485 		 *	if there were file variables declared at this level
486 		 *	call pclose( &__disply[ cbn ] ) to clean them up.
487 		 */
488 	    if ( dfiles[ cbn ] ) {
489 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
490 			, "_PCLOSE" );
491 		putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave )
492 			, P2PTR | P2CHAR );
493 		putop( P2CALL , P2INT );
494 		putdot( filename , line );
495 	    }
496 		/*
497 		 *	if this is a function,
498 		 *	the function variable is the return value.
499 		 *	if it's a scalar valued function, return scalar,
500 		 *	else, return a pointer to the structure value.
501 		 */
502 	    if ( fp -> class == FUNC ) {
503 		struct nl	*fvar = fp -> ptr[ NL_FVAR ];
504 		long		fvartype = p2type( fvar -> type );
505 		long		label;
506 		char		labelname[ BUFSIZ ];
507 
508 		switch ( classify( fvar -> type ) ) {
509 		    case TBOOL:
510 		    case TCHAR:
511 		    case TINT:
512 		    case TSCAL:
513 		    case TDOUBLE:
514 		    case TPTR:
515 			putRV( fvar -> symbol , ( fvar -> nl_block ) & 037
516 				, fvar -> value[ NL_OFFS ] , fvartype );
517 			break;
518 		    default:
519 			label = getlab();
520 			sprintf( labelname , PREFIXFORMAT ,
521 				LABELPREFIX , label );
522 			putprintf( "	.data" , 0 );
523 			putprintf( "	.lcomm	%s,%d" , 0 ,
524 				    labelname , lwidth( fvar -> type ) );
525 			putprintf( "	.text" , 0 );
526 			putleaf( P2NAME , 0 , 0 , fvartype , labelname );
527 			putLV( fvar -> symbol , ( fvar -> nl_block ) & 037
528 				, fvar -> value[ NL_OFFS ] , fvartype );
529 			putstrop( P2STASG , fvartype , lwidth( fvar -> type ) ,
530 				align( fvar -> type ) );
531 			putdot( filename , line );
532 			putleaf( P2ICON , 0 , 0 , fvartype , labelname );
533 			break;
534 		}
535 		putop( P2FORCE , fvartype );
536 		putdot( filename , line );
537 	    }
538 		/*
539 		 *	restore old display entry from save area
540 		 */
541 
542 	    putprintf( "	movq	%d(%s),%s+%d" , 0
543 		, DSAVEOFFSET , P2FPNAME
544 		, DISPLAYNAME , cbn * sizeof(struct dispsave) );
545 	    stabrbrac( cbn );
546 	    putprintf( "	ret" , 0 );
547 		/*
548 		 *	let the second pass allocate locals
549 		 * 	and registers
550 		 */
551 	    putprintf( "	.set	" , 1 );
552 	    putprintf( PREFIXFORMAT , 1 , LABELPREFIX , savlabel );
553 	    putprintf( ", 0x%x" , 0 , savmask() );
554 	    putlab( botlabel );
555 	    putprintf( "	subl2	$LF%d,sp" , 0 , ftnno );
556 	    putrbracket( ftnno );
557 	    putjbr( toplabel );
558 		/*
559 		 *	declare pcp counters, if any
560 		 */
561 	    if ( monflg && fp -> class == PROG ) {
562 		putprintf( "	.data" , 0 );
563 		putprintf( "	.comm	" , 1 );
564 		putprintf( PCPCOUNT , 1 );
565 		putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) );
566 		putprintf( "	.text" , 0 );
567 	    }
568 #	endif PC
569 #ifdef DEBUG
570 	dumpnl(fp->ptr[2], fp->symbol);
571 #endif
572 	/*
573 	 * Restore the
574 	 * (virtual) name list
575 	 * position
576 	 */
577 	nlfree(fp->ptr[2]);
578 	/*
579 	 * Proc/func has been
580 	 * resolved
581 	 */
582 	fp->nl_flags &= ~NFORWD;
583 	/*
584 	 * Patch the beg
585 	 * of the proc/func to
586 	 * the proper variable size
587 	 */
588 	if (Fp == NIL)
589 		elineon();
590 #	ifdef OBJ
591 	    patchfil(var, (long)(-sizes[cbn].om_max), 2);
592 #	endif OBJ
593 	cbn--;
594 	if (inpflist(fp->symbol)) {
595 		opop('l');
596 	}
597 }
598