xref: /csrg-svn/usr.bin/pascal/src/flvalue.c (revision 62211)
148116Sbostic /*-
2*62211Sbostic  * Copyright (c) 1980, 1993
3*62211Sbostic  *	The Regents of the University of California.  All rights reserved.
448116Sbostic  *
548116Sbostic  * %sccs.include.redist.c%
622166Sdist  */
7910Speter 
814732Sthien #ifndef lint
9*62211Sbostic static char sccsid[] = "@(#)flvalue.c	8.1 (Berkeley) 06/06/93";
1048116Sbostic #endif /* not lint */
11910Speter 
12910Speter #include "whoami.h"
13910Speter #include "0.h"
14910Speter #include "tree.h"
15910Speter #include "opcode.h"
16910Speter #include "objfmt.h"
1714732Sthien #include "tree_ty.h"
18910Speter #ifdef PC
19910Speter #   include "pc.h"
2018459Sralph #   include <pcc.h>
21910Speter #endif PC
2211328Speter #include "tmps.h"
23910Speter 
24910Speter     /*
25910Speter      *	flvalue generates the code to either pass on a formal routine,
26910Speter      *	or construct the structure which is the environment for passing.
27910Speter      *	it tells the difference by looking at the tree it's given.
28910Speter      */
29910Speter struct nl *
flvalue(r,formalp)301202Speter flvalue( r , formalp )
3114732Sthien     struct tnode *r; 	/* T_VAR */
321202Speter     struct nl	*formalp;
33910Speter     {
34910Speter 	struct nl	*p;
353826Speter 	struct nl	*tempnlp;
361202Speter 	char		*typename;
373364Speter #ifdef PC
383364Speter 	char		extname[ BUFSIZ ];
393364Speter #endif PC
40910Speter 
4114732Sthien 	if ( r == TR_NIL ) {
4214732Sthien 	    return NLNIL;
43910Speter 	}
441202Speter 	typename = formalp -> class == FFUNC ? "function":"procedure";
4514732Sthien 	if ( r->tag != T_VAR ) {
461202Speter 	    error("Expression given, %s required for %s parameter %s" ,
471202Speter 		    typename , typename , formalp -> symbol );
4814732Sthien 	    return NLNIL;
491202Speter 	}
5014732Sthien 	p = lookup(r->var_node.cptr);
5114732Sthien 	if (p == NLNIL) {
5214732Sthien 	    return NLNIL;
53910Speter 	}
541202Speter 	switch ( p -> class ) {
551202Speter 	    case FFUNC:
561202Speter 	    case FPROC:
5714732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
581202Speter 			error("Formal %s %s cannot be qualified" ,
591202Speter 				typename , p -> symbol );
6014732Sthien 			return NLNIL;
61910Speter 		    }
62910Speter #		    ifdef OBJ
6314732Sthien 			(void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
64910Speter #		    endif OBJ
65910Speter #		    ifdef PC
66910Speter 			putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
673826Speter 				p -> extra_flags ,
68910Speter 				p2type( p ) );
69910Speter #		    endif PC
703298Smckusic 		    return p;
711202Speter 	    case FUNC:
721202Speter 	    case PROC:
7314732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
741202Speter 			error("%s %s cannot be qualified" , typename ,
751202Speter 				p -> symbol );
7614732Sthien 			return NLNIL;
77910Speter 		    }
781202Speter 		    if (bn == 0) {
791202Speter 			error("Built-in %s %s cannot be passed as a parameter" ,
801202Speter 				typename , p -> symbol );
8114732Sthien 			return NLNIL;
82910Speter 		    }
83910Speter 			/*
843427Speter 			 *	allocate space for the thunk
85910Speter 			 */
8614732Sthien 		    tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG);
87910Speter #		    ifdef OBJ
8814732Sthien 			(void) put(2 , O_LV | cbn << 8 + INDX ,
893826Speter 				(int)tempnlp -> value[ NL_OFFS ] );
9014732Sthien 			(void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]);
91910Speter #		    endif OBJ
92910Speter #		    ifdef PC
9318459Sralph 			putleaf( PCC_ICON , 0 , 0 ,
9418459Sralph 			    PCCM_ADDTYPE( PCCTM_PTR , PCCM_ADDTYPE( PCCTM_FTN , PCCTM_PTR|PCCT_STRTY ) ) ,
95910Speter 			    "_FSAV" );
963427Speter 			sprintf( extname , "%s" , FORMALPREFIX );
973427Speter 			sextname( &extname[ strlen( extname ) ] ,
983427Speter 				    p -> symbol , bn );
9918459Sralph 			putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
10018459Sralph 			putleaf( PCC_ICON , bn , 0 , PCCT_INT , (char *) 0 );
10118459Sralph 			putop( PCC_CM , PCCT_INT );
10214732Sthien 			putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] ,
10318459Sralph 				tempnlp -> extra_flags , PCCT_STRTY );
10418459Sralph 			putop( PCC_CM , PCCT_INT );
10518459Sralph 			putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
106910Speter #		    endif PC
1073298Smckusic 		    return p;
108910Speter 	    default:
1091202Speter 		    error("Variable given, %s required for %s parameter %s" ,
1101202Speter 			    typename , typename , formalp -> symbol );
11114732Sthien 		    return NLNIL;
112910Speter 	}
113910Speter     }
114