xref: /csrg-svn/usr.bin/pascal/src/flvalue.c (revision 18459)
1910Speter /* Copyright (c) 1980 Regents of the University of California */
2910Speter 
314732Sthien #ifndef lint
4*18459Sralph static char sccsid[] = "@(#)flvalue.c 2.2 03/20/85";
514732Sthien #endif
6910Speter 
7910Speter #include "whoami.h"
8910Speter #include "0.h"
9910Speter #include "tree.h"
10910Speter #include "opcode.h"
11910Speter #include "objfmt.h"
1214732Sthien #include "tree_ty.h"
13910Speter #ifdef PC
14910Speter #   include "pc.h"
15*18459Sralph #   include <pcc.h>
16910Speter #endif PC
1711328Speter #include "tmps.h"
18910Speter 
19910Speter     /*
20910Speter      *	flvalue generates the code to either pass on a formal routine,
21910Speter      *	or construct the structure which is the environment for passing.
22910Speter      *	it tells the difference by looking at the tree it's given.
23910Speter      */
24910Speter struct nl *
251202Speter flvalue( r , formalp )
2614732Sthien     struct tnode *r; 	/* T_VAR */
271202Speter     struct nl	*formalp;
28910Speter     {
29910Speter 	struct nl	*p;
303826Speter 	struct nl	*tempnlp;
311202Speter 	char		*typename;
323364Speter #ifdef PC
333364Speter 	char		extname[ BUFSIZ ];
343364Speter #endif PC
35910Speter 
3614732Sthien 	if ( r == TR_NIL ) {
3714732Sthien 	    return NLNIL;
38910Speter 	}
391202Speter 	typename = formalp -> class == FFUNC ? "function":"procedure";
4014732Sthien 	if ( r->tag != T_VAR ) {
411202Speter 	    error("Expression given, %s required for %s parameter %s" ,
421202Speter 		    typename , typename , formalp -> symbol );
4314732Sthien 	    return NLNIL;
441202Speter 	}
4514732Sthien 	p = lookup(r->var_node.cptr);
4614732Sthien 	if (p == NLNIL) {
4714732Sthien 	    return NLNIL;
48910Speter 	}
491202Speter 	switch ( p -> class ) {
501202Speter 	    case FFUNC:
511202Speter 	    case FPROC:
5214732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
531202Speter 			error("Formal %s %s cannot be qualified" ,
541202Speter 				typename , p -> symbol );
5514732Sthien 			return NLNIL;
56910Speter 		    }
57910Speter #		    ifdef OBJ
5814732Sthien 			(void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
59910Speter #		    endif OBJ
60910Speter #		    ifdef PC
61910Speter 			putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
623826Speter 				p -> extra_flags ,
63910Speter 				p2type( p ) );
64910Speter #		    endif PC
653298Smckusic 		    return p;
661202Speter 	    case FUNC:
671202Speter 	    case PROC:
6814732Sthien 		    if ( r->var_node.qual != TR_NIL ) {
691202Speter 			error("%s %s cannot be qualified" , typename ,
701202Speter 				p -> symbol );
7114732Sthien 			return NLNIL;
72910Speter 		    }
731202Speter 		    if (bn == 0) {
741202Speter 			error("Built-in %s %s cannot be passed as a parameter" ,
751202Speter 				typename , p -> symbol );
7614732Sthien 			return NLNIL;
77910Speter 		    }
78910Speter 			/*
793427Speter 			 *	allocate space for the thunk
80910Speter 			 */
8114732Sthien 		    tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG);
82910Speter #		    ifdef OBJ
8314732Sthien 			(void) put(2 , O_LV | cbn << 8 + INDX ,
843826Speter 				(int)tempnlp -> value[ NL_OFFS ] );
8514732Sthien 			(void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]);
86910Speter #		    endif OBJ
87910Speter #		    ifdef PC
88*18459Sralph 			putleaf( PCC_ICON , 0 , 0 ,
89*18459Sralph 			    PCCM_ADDTYPE( PCCTM_PTR , PCCM_ADDTYPE( PCCTM_FTN , PCCTM_PTR|PCCT_STRTY ) ) ,
90910Speter 			    "_FSAV" );
913427Speter 			sprintf( extname , "%s" , FORMALPREFIX );
923427Speter 			sextname( &extname[ strlen( extname ) ] ,
933427Speter 				    p -> symbol , bn );
94*18459Sralph 			putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
95*18459Sralph 			putleaf( PCC_ICON , bn , 0 , PCCT_INT , (char *) 0 );
96*18459Sralph 			putop( PCC_CM , PCCT_INT );
9714732Sthien 			putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] ,
98*18459Sralph 				tempnlp -> extra_flags , PCCT_STRTY );
99*18459Sralph 			putop( PCC_CM , PCCT_INT );
100*18459Sralph 			putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
101910Speter #		    endif PC
1023298Smckusic 		    return p;
103910Speter 	    default:
1041202Speter 		    error("Variable given, %s required for %s parameter %s" ,
1051202Speter 			    typename , typename , formalp -> symbol );
10614732Sthien 		    return NLNIL;
107910Speter 	}
108910Speter     }
109