1*910Speter /* Copyright (c) 1980 Regents of the University of California */
2*910Speter 
3*910Speter static	char sccsid[] = "@(#)flvalue.c 1.1 09/24/80";
4*910Speter 
5*910Speter #include "whoami.h"
6*910Speter #include "0.h"
7*910Speter #include "tree.h"
8*910Speter #include "opcode.h"
9*910Speter #include "objfmt.h"
10*910Speter #ifdef PC
11*910Speter #   include "pc.h"
12*910Speter #   include "pcops.h"
13*910Speter #endif PC
14*910Speter 
15*910Speter     /*
16*910Speter      *	flvalue generates the code to either pass on a formal routine,
17*910Speter      *	or construct the structure which is the environment for passing.
18*910Speter      *	it tells the difference by looking at the tree it's given.
19*910Speter      */
20*910Speter struct nl *
21*910Speter flvalue( r )
22*910Speter     int	*r;
23*910Speter     {
24*910Speter 	struct nl	*p;
25*910Speter 	long		tempoff;
26*910Speter 
27*910Speter 	if ( r == NIL ) {
28*910Speter 	    return NIL;
29*910Speter 	}
30*910Speter 	p = lookup(r[2]);
31*910Speter 	if (p == NIL) {
32*910Speter 		return NIL;
33*910Speter 	}
34*910Speter 	switch ( r[0] ) {
35*910Speter 	    case T_FFUNC:
36*910Speter 		    if ( r[3] != NIL ) {
37*910Speter 			error("Formal function %s cannot be qualified" ,
38*910Speter 				p -> symbol );
39*910Speter 			return NIL;
40*910Speter 		    }
41*910Speter 		    goto froutine;
42*910Speter 	    case T_FPROC:
43*910Speter 		    if ( r[3] != NIL ) {
44*910Speter 			error("Formal procedure %s cannot be qualified" ,
45*910Speter 				p -> symbol );
46*910Speter 			return NIL;
47*910Speter 		    }
48*910Speter 	    froutine:
49*910Speter #		    ifdef OBJ
50*910Speter 			put( 2 , PTR_RV | bn << 8+INDX , p -> value[NL_OFFS] );
51*910Speter #		    endif OBJ
52*910Speter #		    ifdef PC
53*910Speter 			putRV( p -> symbol , bn , p -> value[ NL_OFFS ] ,
54*910Speter 				p2type( p ) );
55*910Speter #		    endif PC
56*910Speter 		    return p -> type;
57*910Speter 	    case T_FUNC:
58*910Speter 		    if ( r[3] != NIL ) {
59*910Speter 			error("Function %s cannot be qualified" , p -> symbol );
60*910Speter 			return NIL;
61*910Speter 		    }
62*910Speter 		    goto routine;
63*910Speter 	    case T_PROC:
64*910Speter 		    if ( r[3] != NIL ) {
65*910Speter 			error("Procedure %s cannot be qualified", p -> symbol );
66*910Speter 			return NIL;
67*910Speter 		    }
68*910Speter 	    routine:
69*910Speter 			/*
70*910Speter 			 *	formal routine structure:
71*910Speter 			 *
72*910Speter 			 *	struct formalrtn {
73*910Speter 			 *		long		(*entryaddr)();
74*910Speter 			 *		long		cbn;
75*910Speter 			 *		struct dispsave	disp[2*MAXLVL];
76*910Speter 			 *	};
77*910Speter 			 */
78*910Speter 		    sizes[ cbn ].om_off -=	  sizeof (long (*()))
79*910Speter 						+ sizeof (long)
80*910Speter 						+ 2*bn*sizeof (struct dispsave);
81*910Speter 		    tempoff = sizes[ cbn ].om_off;
82*910Speter 		    if ( sizes[ cbn ].om_off < sizes[ cbn ].om_max ) {
83*910Speter 			sizes[ cbn ].om_max = tempoff;
84*910Speter 		    }
85*910Speter #		    ifdef OBJ
86*910Speter 			put( 2 , PTR_LV | cbn << 8 + INDX , tempoff );
87*910Speter 			put( 2 , O_FSAV | bn << 8 + INDX , p -> entloc );
88*910Speter #		    endif OBJ
89*910Speter #		    ifdef PC
90*910Speter 			putlbracket( ftnno , -tempoff );
91*910Speter 			putleaf( P2ICON , 0 , 0 ,
92*910Speter 			    ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STR ) ) ,
93*910Speter 			    "_FSAV" );
94*910Speter 			{
95*910Speter 			    char	extname[ BUFSIZ ];
96*910Speter 			    char	*starthere;
97*910Speter 			    int		i;
98*910Speter 
99*910Speter 			    starthere = &extname[0];
100*910Speter 			    for ( i = 1 ; i < bn ; i++ ) {
101*910Speter 				sprintf( starthere , EXTFORMAT , enclosing[ i ] );
102*910Speter 				starthere += strlen( enclosing[ i ] ) + 1;
103*910Speter 			    }
104*910Speter 			    sprintf( starthere , EXTFORMAT , p -> symbol );
105*910Speter 			    starthere += strlen( p -> symbol ) + 1;
106*910Speter 			    if ( starthere >= &extname[ BUFSIZ ] ) {
107*910Speter 				panic( "flvalue namelength" );
108*910Speter 			    }
109*910Speter 			    putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
110*910Speter 			}
111*910Speter 			putleaf( P2ICON , bn , 0 , P2INT , 0 );
112*910Speter 			putop( P2LISTOP , P2INT );
113*910Speter 			putLV( 0 , cbn , tempoff , P2STR );
114*910Speter 			putop( P2LISTOP , P2INT );
115*910Speter 			putop( P2CALL , P2PTR | P2STRTY );
116*910Speter #		    endif PC
117*910Speter 		    return p -> type;
118*910Speter 	    default:
119*910Speter 		    panic("flvalue");
120*910Speter 	}
121*910Speter     }
122