1910Speter /* Copyright (c) 1980 Regents of the University of California */ 2910Speter 3*14732Sthien #ifndef lint 4*14732Sthien static char sccsid[] = "@(#)flvalue.c 1.14 08/19/83"; 5*14732Sthien #endif 6910Speter 7910Speter #include "whoami.h" 8910Speter #include "0.h" 9910Speter #include "tree.h" 10910Speter #include "opcode.h" 11910Speter #include "objfmt.h" 12*14732Sthien #include "tree_ty.h" 13910Speter #ifdef PC 14910Speter # include "pc.h" 15910Speter # include "pcops.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 ) 26*14732Sthien 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 36*14732Sthien if ( r == TR_NIL ) { 37*14732Sthien return NLNIL; 38910Speter } 391202Speter typename = formalp -> class == FFUNC ? "function":"procedure"; 40*14732Sthien if ( r->tag != T_VAR ) { 411202Speter error("Expression given, %s required for %s parameter %s" , 421202Speter typename , typename , formalp -> symbol ); 43*14732Sthien return NLNIL; 441202Speter } 45*14732Sthien p = lookup(r->var_node.cptr); 46*14732Sthien if (p == NLNIL) { 47*14732Sthien return NLNIL; 48910Speter } 491202Speter switch ( p -> class ) { 501202Speter case FFUNC: 511202Speter case FPROC: 52*14732Sthien if ( r->var_node.qual != TR_NIL ) { 531202Speter error("Formal %s %s cannot be qualified" , 541202Speter typename , p -> symbol ); 55*14732Sthien return NLNIL; 56910Speter } 57910Speter # ifdef OBJ 58*14732Sthien (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: 68*14732Sthien if ( r->var_node.qual != TR_NIL ) { 691202Speter error("%s %s cannot be qualified" , typename , 701202Speter p -> symbol ); 71*14732Sthien return NLNIL; 72910Speter } 731202Speter if (bn == 0) { 741202Speter error("Built-in %s %s cannot be passed as a parameter" , 751202Speter typename , p -> symbol ); 76*14732Sthien return NLNIL; 77910Speter } 78910Speter /* 793427Speter * allocate space for the thunk 80910Speter */ 81*14732Sthien tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG); 82910Speter # ifdef OBJ 83*14732Sthien (void) put(2 , O_LV | cbn << 8 + INDX , 843826Speter (int)tempnlp -> value[ NL_OFFS ] ); 85*14732Sthien (void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]); 86910Speter # endif OBJ 87910Speter # ifdef PC 88910Speter putleaf( P2ICON , 0 , 0 , 891202Speter ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 90910Speter "_FSAV" ); 913427Speter sprintf( extname , "%s" , FORMALPREFIX ); 923427Speter sextname( &extname[ strlen( extname ) ] , 933427Speter p -> symbol , bn ); 943364Speter putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 95*14732Sthien putleaf( P2ICON , bn , 0 , P2INT , (char *) 0 ); 96910Speter putop( P2LISTOP , P2INT ); 97*14732Sthien putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] , 983826Speter tempnlp -> extra_flags , P2STRTY ); 99910Speter putop( P2LISTOP , P2INT ); 100910Speter putop( P2CALL , P2PTR | P2STRTY ); 101910Speter # endif PC 1023298Smckusic return p; 103910Speter default: 1041202Speter error("Variable given, %s required for %s parameter %s" , 1051202Speter typename , typename , formalp -> symbol ); 106*14732Sthien return NLNIL; 107910Speter } 108910Speter } 109