1910Speter /* Copyright (c) 1980 Regents of the University of California */ 2910Speter 3*3427Speter static char sccsid[] = "@(#)flvalue.c 1.9 04/01/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; 26910Speter long tempoff; 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 ] , 58910Speter p2type( p ) ); 59910Speter # endif PC 603298Smckusic return p; 611202Speter case FUNC: 621202Speter case PROC: 63910Speter if ( r[3] != NIL ) { 641202Speter error("%s %s cannot be qualified" , typename , 651202Speter p -> symbol ); 66910Speter return NIL; 67910Speter } 681202Speter if (bn == 0) { 691202Speter error("Built-in %s %s cannot be passed as a parameter" , 701202Speter typename , p -> symbol ); 71910Speter return NIL; 72910Speter } 73910Speter /* 74*3427Speter * allocate space for the thunk 75910Speter */ 76*3427Speter tempoff = tmpalloc( sizeof ( struct formalrtn ) , 77*3427Speter nl+TSTR, NOREG); 78910Speter # ifdef OBJ 793074Smckusic put(2 , O_LV | cbn << 8 + INDX , (int)tempoff ); 803074Smckusic put(2, O_FSAV | bn << 8, (long)p->entloc); 81910Speter # endif OBJ 82910Speter # ifdef PC 83910Speter putleaf( P2ICON , 0 , 0 , 841202Speter ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 85910Speter "_FSAV" ); 86*3427Speter sprintf( extname , "%s" , FORMALPREFIX ); 87*3427Speter sextname( &extname[ strlen( extname ) ] , 88*3427Speter p -> symbol , bn ); 893364Speter putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 90910Speter putleaf( P2ICON , bn , 0 , P2INT , 0 ); 91910Speter putop( P2LISTOP , P2INT ); 921202Speter putLV( 0 , cbn , tempoff , P2STRTY ); 93910Speter putop( P2LISTOP , P2INT ); 94910Speter putop( P2CALL , P2PTR | P2STRTY ); 95910Speter # endif PC 963298Smckusic return p; 97910Speter default: 981202Speter error("Variable given, %s required for %s parameter %s" , 991202Speter typename , typename , formalp -> symbol ); 1001202Speter return NIL; 101910Speter } 102910Speter } 103