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