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