1910Speter /* Copyright (c) 1980 Regents of the University of California */ 2910Speter 3*4031Smckusic static char sccsid[] = "@(#)flvalue.c 1.11 07/23/81"; 4910Speter 5910Speter #include "whoami.h" 6910Speter #include "0.h" 7910Speter #include "tree.h" 8910Speter #include "opcode.h" 9910Speter #include "objfmt.h" 10910Speter #ifdef PC 11910Speter # include "pc.h" 12910Speter # include "pcops.h" 13910Speter #endif PC 14910Speter 15910Speter /* 16910Speter * flvalue generates the code to either pass on a formal routine, 17910Speter * or construct the structure which is the environment for passing. 18910Speter * it tells the difference by looking at the tree it's given. 19910Speter */ 20910Speter struct nl * 211202Speter flvalue( r , formalp ) 221202Speter int *r; 231202Speter struct nl *formalp; 24910Speter { 25910Speter struct nl *p; 263826Speter struct nl *tempnlp; 271202Speter char *typename; 283364Speter #ifdef PC 293364Speter char extname[ BUFSIZ ]; 303364Speter #endif PC 31910Speter 32910Speter if ( r == NIL ) { 33910Speter return NIL; 34910Speter } 351202Speter typename = formalp -> class == FFUNC ? "function":"procedure"; 361202Speter if ( r[0] != T_VAR ) { 371202Speter error("Expression given, %s required for %s parameter %s" , 381202Speter typename , typename , formalp -> symbol ); 391202Speter return NIL; 401202Speter } 41910Speter p = lookup(r[2]); 42910Speter if (p == NIL) { 431202Speter return NIL; 44910Speter } 451202Speter switch ( p -> class ) { 461202Speter case FFUNC: 471202Speter case FPROC: 48910Speter if ( r[3] != NIL ) { 491202Speter error("Formal %s %s cannot be qualified" , 501202Speter typename , p -> symbol ); 51910Speter return NIL; 52910Speter } 53910Speter # ifdef OBJ 543074Smckusic put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]); 55910Speter # endif OBJ 56910Speter # ifdef PC 57910Speter putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 583826Speter p -> extra_flags , 59910Speter p2type( p ) ); 60910Speter # endif PC 613298Smckusic return p; 621202Speter case FUNC: 631202Speter case PROC: 64910Speter if ( r[3] != NIL ) { 651202Speter error("%s %s cannot be qualified" , typename , 661202Speter p -> symbol ); 67910Speter return NIL; 68910Speter } 691202Speter if (bn == 0) { 701202Speter error("Built-in %s %s cannot be passed as a parameter" , 711202Speter typename , p -> symbol ); 72910Speter return NIL; 73910Speter } 74910Speter /* 753427Speter * allocate space for the thunk 76910Speter */ 77*4031Smckusic tempnlp = tmpalloc(sizeof(struct formalrtn), NIL, NOREG); 78910Speter # ifdef OBJ 793826Speter put(2 , O_LV | cbn << 8 + INDX , 803826Speter (int)tempnlp -> value[ NL_OFFS ] ); 813074Smckusic put(2, O_FSAV | bn << 8, (long)p->entloc); 82910Speter # endif OBJ 83910Speter # ifdef PC 84910Speter putleaf( P2ICON , 0 , 0 , 851202Speter ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 86910Speter "_FSAV" ); 873427Speter sprintf( extname , "%s" , FORMALPREFIX ); 883427Speter sextname( &extname[ strlen( extname ) ] , 893427Speter p -> symbol , bn ); 903364Speter putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 91910Speter putleaf( P2ICON , bn , 0 , P2INT , 0 ); 92910Speter putop( P2LISTOP , P2INT ); 933826Speter putLV( 0 , cbn , tempnlp -> value[NL_OFFS] , 943826Speter tempnlp -> extra_flags , P2STRTY ); 95910Speter putop( P2LISTOP , P2INT ); 96910Speter putop( P2CALL , P2PTR | P2STRTY ); 97910Speter # endif PC 983298Smckusic return p; 99910Speter default: 1001202Speter error("Variable given, %s required for %s parameter %s" , 1011202Speter typename , typename , formalp -> symbol ); 1021202Speter return NIL; 103910Speter } 104910Speter } 105