1 /* Copyright (c) 1980 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)flvalue.c 1.15 09/19/83"; 5 #endif 6 7 #include "whoami.h" 8 #include "0.h" 9 #include "tree.h" 10 #include "opcode.h" 11 #include "objfmt.h" 12 #include "tree_ty.h" 13 #ifdef PC 14 # include "pc.h" 15 # include "pcops.h" 16 #endif PC 17 #include "tmps.h" 18 19 /* 20 * flvalue generates the code to either pass on a formal routine, 21 * or construct the structure which is the environment for passing. 22 * it tells the difference by looking at the tree it's given. 23 */ 24 struct nl * 25 flvalue( r , formalp ) 26 struct tnode *r; /* T_VAR */ 27 struct nl *formalp; 28 { 29 struct nl *p; 30 struct nl *tempnlp; 31 char *typename; 32 #ifdef PC 33 char extname[ BUFSIZ ]; 34 #endif PC 35 36 if ( r == TR_NIL ) { 37 return NLNIL; 38 } 39 typename = formalp -> class == FFUNC ? "function":"procedure"; 40 if ( r->tag != T_VAR ) { 41 error("Expression given, %s required for %s parameter %s" , 42 typename , typename , formalp -> symbol ); 43 return NLNIL; 44 } 45 p = lookup(r->var_node.cptr); 46 if (p == NLNIL) { 47 return NLNIL; 48 } 49 switch ( p -> class ) { 50 case FFUNC: 51 case FPROC: 52 if ( r->var_node.qual != TR_NIL ) { 53 error("Formal %s %s cannot be qualified" , 54 typename , p -> symbol ); 55 return NLNIL; 56 } 57 # ifdef OBJ 58 (void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]); 59 # endif OBJ 60 # ifdef PC 61 putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 62 p -> extra_flags , 63 p2type( p ) ); 64 # endif PC 65 return p; 66 case FUNC: 67 case PROC: 68 if ( r->var_node.qual != TR_NIL ) { 69 error("%s %s cannot be qualified" , typename , 70 p -> symbol ); 71 return NLNIL; 72 } 73 if (bn == 0) { 74 error("Built-in %s %s cannot be passed as a parameter" , 75 typename , p -> symbol ); 76 return NLNIL; 77 } 78 /* 79 * allocate space for the thunk 80 */ 81 tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG); 82 # ifdef OBJ 83 (void) put(2 , O_LV | cbn << 8 + INDX , 84 (int)tempnlp -> value[ NL_OFFS ] ); 85 (void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]); 86 # endif OBJ 87 # ifdef PC 88 putleaf( P2ICON , 0 , 0 , 89 ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 90 "_FSAV" ); 91 sprintf( extname , "%s" , FORMALPREFIX ); 92 sextname( &extname[ strlen( extname ) ] , 93 p -> symbol , bn ); 94 putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 95 putleaf( P2ICON , bn , 0 , P2INT , (char *) 0 ); 96 putop( P2LISTOP , P2INT ); 97 putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] , 98 tempnlp -> extra_flags , P2STRTY ); 99 putop( P2LISTOP , P2INT ); 100 putop( P2CALL , P2PTR | P2STRTY ); 101 # endif PC 102 return p; 103 default: 104 error("Variable given, %s required for %s parameter %s" , 105 typename , typename , formalp -> symbol ); 106 return NLNIL; 107 } 108 } 109