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