1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)call.c 1.2 08/29/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 default: 139 q = rvalue( argv[1] , p1 -> type , RREQ ); 140 if ( isa( p1 -> type , "d" ) 141 && isa( q , "i" ) ) { 142 putop( P2SCONV , P2DOUBLE ); 143 } 144 break; 145 } 146 # endif PC 147 if (q == NIL) 148 break; 149 if (incompat(q, p1->type, argv[1])) { 150 cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); 151 break; 152 } 153 # ifdef OBJ 154 if (isa(p1->type, "bcsi")) 155 rangechk(p1->type, q); 156 if (q->class != STR) 157 convert(q, p1->type); 158 # endif OBJ 159 # ifdef PC 160 switch( classify( p1 -> type ) ) { 161 case TFILE: 162 case TARY: 163 case TREC: 164 case TSET: 165 case TSTR: 166 putstrop( P2STARG 167 , p2type( p1 -> type ) 168 , lwidth( p1 -> type ) 169 , align( p1 -> type ) ); 170 } 171 # endif PC 172 break; 173 default: 174 panic("call"); 175 } 176 # ifdef PC 177 /* 178 * if this is the nth (>1) argument, 179 * hang it on the left linear list of arguments 180 */ 181 if ( firsttime ) { 182 firsttime = FALSE; 183 } else { 184 putop( P2LISTOP , P2INT ); 185 } 186 # endif PC 187 argv = argv[2]; 188 } 189 if (argv != NIL) { 190 error("Too many arguments to %s", p->symbol); 191 rvlist(argv); 192 return (NIL); 193 } 194 # ifdef OBJ 195 put2(O_CALL | psbn << 8+INDX, p->entloc); 196 put2(O_POP, p->value[NL_OFFS]-DPOFF2); 197 # endif OBJ 198 # ifdef PC 199 if ( porf == FUNC ) { 200 rettype = p2type( p -> type ); 201 switch ( classify( p -> type ) ) { 202 case TBOOL: 203 case TCHAR: 204 case TINT: 205 case TSCAL: 206 case TDOUBLE: 207 case TPTR: 208 if ( p -> chain == NIL ) { 209 putop( P2UNARY P2CALL , rettype ); 210 } else { 211 putop( P2CALL , rettype ); 212 } 213 break; 214 default: 215 if ( p -> chain == NIL ) { 216 putstrop( P2UNARY P2STCALL 217 , ADDTYPE( rettype , P2PTR ) 218 , lwidth( p -> type ) 219 , align( p -> type ) ); 220 } else { 221 putstrop( P2STCALL 222 , ADDTYPE( rettype , P2PTR ) 223 , lwidth( p -> type ) 224 , align( p -> type ) ); 225 } 226 putstrop( P2STASG , rettype , lwidth( p -> type ) 227 , align( p -> type ) ); 228 putLV( 0 , cbn , temp , rettype ); 229 putop( P2COMOP , P2INT ); 230 break; 231 } 232 } else { 233 if ( p -> chain == NIL ) { 234 putop( P2UNARY P2CALL , P2INT ); 235 } else { 236 putop( P2CALL , P2INT ); 237 } 238 putdot( filename , line ); 239 } 240 # endif PC 241 return (p->type); 242 } 243 244 rvlist(al) 245 register int *al; 246 { 247 248 for (; al != NIL; al = al[2]) 249 rvalue( (int *) al[1], NLNIL , RREQ ); 250 } 251