1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)call.c 1.1 08/27/80"; 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 * Call generates code for calls to 17 * user defined procedures and functions 18 * and is called by proc and funccod. 19 * P is the result of the lookup 20 * of the procedure/function symbol, 21 * and porf is PROC or FUNC. 22 * Psbn is the block number of p. 23 */ 24 struct nl * 25 call(p, argv, porf, psbn) 26 struct nl *p; 27 int *argv, porf, psbn; 28 { 29 register struct nl *p1, *q; 30 int *r; 31 32 # ifdef PC 33 long temp; 34 int firsttime; 35 int rettype; 36 # endif PC 37 38 # ifdef OBJ 39 if (porf == FUNC) 40 /* 41 * Push some space 42 * for the function return type 43 */ 44 put2(O_PUSH, even(-width(p->type))); 45 # endif OBJ 46 # ifdef PC 47 if ( porf == FUNC ) { 48 switch( classify( p -> type ) ) { 49 case TSTR: 50 case TSET: 51 case TREC: 52 case TFILE: 53 case TARY: 54 temp = sizes[ cbn ].om_off -= width( p -> type ); 55 putlbracket( ftnno , -sizes[cbn].om_off ); 56 if (sizes[cbn].om_off < sizes[cbn].om_max) { 57 sizes[cbn].om_max = sizes[cbn].om_off; 58 } 59 putRV( 0 , cbn , temp , P2STRTY ); 60 } 61 } 62 { 63 char extname[ BUFSIZ ]; 64 char *starthere; 65 int funcbn; 66 int i; 67 68 starthere = &extname[0]; 69 funcbn = p -> nl_block & 037; 70 for ( i = 1 ; i < funcbn ; i++ ) { 71 sprintf( starthere , EXTFORMAT , enclosing[ i ] ); 72 starthere += strlen( enclosing[ i ] ) + 1; 73 } 74 sprintf( starthere , EXTFORMAT , p -> symbol ); 75 starthere += strlen( p -> symbol ) + 1; 76 if ( starthere >= &extname[ BUFSIZ ] ) { 77 panic( "call namelength" ); 78 } 79 putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 80 } 81 firsttime = TRUE; 82 # endif PC 83 /* 84 * Loop and process each of 85 * arguments to the proc/func. 86 */ 87 for (p1 = p->chain; p1 != NIL; p1 = p1->chain) { 88 if (argv == NIL) { 89 error("Not enough arguments to %s", p->symbol); 90 return (NIL); 91 } 92 switch (p1->class) { 93 case REF: 94 /* 95 * Var parameter 96 */ 97 r = argv[1]; 98 if (r != NIL && r[0] != T_VAR) { 99 error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); 100 break; 101 } 102 q = lvalue( (int *) argv[1], MOD , LREQ ); 103 if (q == NIL) 104 break; 105 if (q != p1->type) { 106 error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); 107 break; 108 } 109 break; 110 case VAR: 111 /* 112 * Value parameter 113 */ 114 # ifdef OBJ 115 q = rvalue(argv[1], p1->type , RREQ ); 116 # endif OBJ 117 # ifdef PC 118 /* 119 * structure arguments require lvalues, 120 * scalars use rvalue. 121 */ 122 switch( classify( p1 -> type ) ) { 123 case TFILE: 124 case TARY: 125 case TREC: 126 case TSET: 127 case TSTR: 128 q = rvalue( argv[1] , p1 -> type , LREQ ); 129 break; 130 case TINT: 131 case TSCAL: 132 case TBOOL: 133 case TCHAR: 134 precheck( p1 -> type , "_RANG4" , "_RSNG4" ); 135 q = rvalue( argv[1] , p1 -> type , RREQ ); 136 postcheck( p1 -> type ); 137 break; 138 /* 139 * and fall through 140 */ 141 default: 142 q = rvalue( argv[1] , p1 -> type , RREQ ); 143 break; 144 } 145 # endif PC 146 if (q == NIL) 147 break; 148 if (incompat(q, p1->type, argv[1])) { 149 cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); 150 break; 151 } 152 # ifdef OBJ 153 if (isa(p1->type, "bcsi")) 154 rangechk(p1->type, q); 155 if (q->class != STR) 156 convert(q, p1->type); 157 # endif OBJ 158 # ifdef PC 159 switch( classify( p1 -> type ) ) { 160 case TFILE: 161 case TARY: 162 case TREC: 163 case TSET: 164 case TSTR: 165 putstrop( P2STARG 166 , p2type( p1 -> type ) 167 , lwidth( p1 -> type ) 168 , align( p1 -> type ) ); 169 } 170 # endif PC 171 break; 172 default: 173 panic("call"); 174 } 175 # ifdef PC 176 /* 177 * if this is the nth (>1) argument, 178 * hang it on the left linear list of arguments 179 */ 180 if ( firsttime ) { 181 firsttime = FALSE; 182 } else { 183 putop( P2LISTOP , P2INT ); 184 } 185 # endif PC 186 argv = argv[2]; 187 } 188 if (argv != NIL) { 189 error("Too many arguments to %s", p->symbol); 190 rvlist(argv); 191 return (NIL); 192 } 193 # ifdef OBJ 194 put2(O_CALL | psbn << 8+INDX, p->entloc); 195 put2(O_POP, p->value[NL_OFFS]-DPOFF2); 196 # endif OBJ 197 # ifdef PC 198 if ( porf == FUNC ) { 199 rettype = p2type( p -> type ); 200 switch ( classify( p -> type ) ) { 201 case TBOOL: 202 case TCHAR: 203 case TINT: 204 case TSCAL: 205 case TDOUBLE: 206 case TPTR: 207 if ( p -> chain == NIL ) { 208 putop( P2UNARY P2CALL , rettype ); 209 } else { 210 putop( P2CALL , rettype ); 211 } 212 break; 213 default: 214 if ( p -> chain == NIL ) { 215 putstrop( P2UNARY P2STCALL 216 , ADDTYPE( rettype , P2PTR ) 217 , lwidth( p -> type ) 218 , align( p -> type ) ); 219 } else { 220 putstrop( P2STCALL 221 , ADDTYPE( rettype , P2PTR ) 222 , lwidth( p -> type ) 223 , align( p -> type ) ); 224 } 225 putstrop( P2STASG , rettype , lwidth( p -> type ) 226 , align( p -> type ) ); 227 putLV( 0 , cbn , temp , rettype ); 228 putop( P2COMOP , P2INT ); 229 break; 230 } 231 } else { 232 if ( p -> chain == NIL ) { 233 putop( P2UNARY P2CALL , P2INT ); 234 } else { 235 putop( P2CALL , P2INT ); 236 } 237 putdot( filename , line ); 238 } 239 # endif PC 240 return (p->type); 241 } 242 243 rvlist(al) 244 register int *al; 245 { 246 247 for (; al != NIL; al = al[2]) 248 rvalue( (int *) al[1], NLNIL , RREQ ); 249 } 250