1 /* Copyright (c) 1980 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)flvalue.c 1.9 04/01/81"; 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 long tempoff; 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 p2type( p ) ); 59 # endif PC 60 return p; 61 case FUNC: 62 case PROC: 63 if ( r[3] != NIL ) { 64 error("%s %s cannot be qualified" , typename , 65 p -> symbol ); 66 return NIL; 67 } 68 if (bn == 0) { 69 error("Built-in %s %s cannot be passed as a parameter" , 70 typename , p -> symbol ); 71 return NIL; 72 } 73 /* 74 * allocate space for the thunk 75 */ 76 tempoff = tmpalloc( sizeof ( struct formalrtn ) , 77 nl+TSTR, NOREG); 78 # ifdef OBJ 79 put(2 , O_LV | cbn << 8 + INDX , (int)tempoff ); 80 put(2, O_FSAV | bn << 8, (long)p->entloc); 81 # endif OBJ 82 # ifdef PC 83 putleaf( P2ICON , 0 , 0 , 84 ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 85 "_FSAV" ); 86 sprintf( extname , "%s" , FORMALPREFIX ); 87 sextname( &extname[ strlen( extname ) ] , 88 p -> symbol , bn ); 89 putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 90 putleaf( P2ICON , bn , 0 , P2INT , 0 ); 91 putop( P2LISTOP , P2INT ); 92 putLV( 0 , cbn , tempoff , P2STRTY ); 93 putop( P2LISTOP , P2INT ); 94 putop( P2CALL , P2PTR | P2STRTY ); 95 # endif PC 96 return p; 97 default: 98 error("Variable given, %s required for %s parameter %s" , 99 typename , typename , formalp -> symbol ); 100 return NIL; 101 } 102 } 103