1910Speter /* Copyright (c) 1980 Regents of the University of California */ 2910Speter 3*11328Speter static char sccsid[] = "@(#)flvalue.c 1.13 02/28/83"; 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 14*11328Speter #include "tmps.h" 15910Speter 16910Speter /* 17910Speter * flvalue generates the code to either pass on a formal routine, 18910Speter * or construct the structure which is the environment for passing. 19910Speter * it tells the difference by looking at the tree it's given. 20910Speter */ 21910Speter struct nl * 221202Speter flvalue( r , formalp ) 231202Speter int *r; 241202Speter struct nl *formalp; 25910Speter { 26910Speter struct nl *p; 273826Speter struct nl *tempnlp; 281202Speter char *typename; 293364Speter #ifdef PC 303364Speter char extname[ BUFSIZ ]; 313364Speter #endif PC 32910Speter 33910Speter if ( r == NIL ) { 34910Speter return NIL; 35910Speter } 361202Speter typename = formalp -> class == FFUNC ? "function":"procedure"; 371202Speter if ( r[0] != T_VAR ) { 381202Speter error("Expression given, %s required for %s parameter %s" , 391202Speter typename , typename , formalp -> symbol ); 401202Speter return NIL; 411202Speter } 42910Speter p = lookup(r[2]); 43910Speter if (p == NIL) { 441202Speter return NIL; 45910Speter } 461202Speter switch ( p -> class ) { 471202Speter case FFUNC: 481202Speter case FPROC: 49910Speter if ( r[3] != NIL ) { 501202Speter error("Formal %s %s cannot be qualified" , 511202Speter typename , p -> symbol ); 52910Speter return NIL; 53910Speter } 54910Speter # ifdef OBJ 553074Smckusic put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]); 56910Speter # endif OBJ 57910Speter # ifdef PC 58910Speter putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 593826Speter p -> extra_flags , 60910Speter p2type( p ) ); 61910Speter # endif PC 623298Smckusic return p; 631202Speter case FUNC: 641202Speter case PROC: 65910Speter if ( r[3] != NIL ) { 661202Speter error("%s %s cannot be qualified" , typename , 671202Speter p -> symbol ); 68910Speter return NIL; 69910Speter } 701202Speter if (bn == 0) { 711202Speter error("Built-in %s %s cannot be passed as a parameter" , 721202Speter typename , p -> symbol ); 73910Speter return NIL; 74910Speter } 75910Speter /* 763427Speter * allocate space for the thunk 77910Speter */ 784031Smckusic tempnlp = tmpalloc(sizeof(struct formalrtn), NIL, NOREG); 79910Speter # ifdef OBJ 803826Speter put(2 , O_LV | cbn << 8 + INDX , 813826Speter (int)tempnlp -> value[ NL_OFFS ] ); 827919Smckusick put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]); 83910Speter # endif OBJ 84910Speter # ifdef PC 85910Speter putleaf( P2ICON , 0 , 0 , 861202Speter ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) , 87910Speter "_FSAV" ); 883427Speter sprintf( extname , "%s" , FORMALPREFIX ); 893427Speter sextname( &extname[ strlen( extname ) ] , 903427Speter p -> symbol , bn ); 913364Speter putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 92910Speter putleaf( P2ICON , bn , 0 , P2INT , 0 ); 93910Speter putop( P2LISTOP , P2INT ); 943826Speter putLV( 0 , cbn , tempnlp -> value[NL_OFFS] , 953826Speter tempnlp -> extra_flags , P2STRTY ); 96910Speter putop( P2LISTOP , P2INT ); 97910Speter putop( P2CALL , P2PTR | P2STRTY ); 98910Speter # endif PC 993298Smckusic return p; 100910Speter default: 1011202Speter error("Variable given, %s required for %s parameter %s" , 1021202Speter typename , typename , formalp -> symbol ); 1031202Speter return NIL; 104910Speter } 105910Speter } 106