1eb9f9eddSpeter /* Copyright (c) 1979 Regents of the University of California */ 2eb9f9eddSpeter 3*10903c71Speter static char sccsid[] = "@(#)call.c 1.17 06/12/81"; 4eb9f9eddSpeter 5eb9f9eddSpeter #include "whoami.h" 6eb9f9eddSpeter #include "0.h" 7eb9f9eddSpeter #include "tree.h" 8eb9f9eddSpeter #include "opcode.h" 9eb9f9eddSpeter #include "objfmt.h" 10eb9f9eddSpeter #ifdef PC 11eb9f9eddSpeter # include "pc.h" 12eb9f9eddSpeter # include "pcops.h" 13eb9f9eddSpeter #endif PC 14eb9f9eddSpeter 15eb9f9eddSpeter /* 16eb9f9eddSpeter * Call generates code for calls to 17eb9f9eddSpeter * user defined procedures and functions 18eb9f9eddSpeter * and is called by proc and funccod. 19eb9f9eddSpeter * P is the result of the lookup 20eb9f9eddSpeter * of the procedure/function symbol, 21eb9f9eddSpeter * and porf is PROC or FUNC. 22eb9f9eddSpeter * Psbn is the block number of p. 23dc03343eSmckusic * 24dc03343eSmckusic * the idea here is that regular scalar functions are just called, 25dc03343eSmckusic * while structure functions and formal functions have their results 26dc03343eSmckusic * stored in a temporary after the call. 27dc03343eSmckusic * structure functions do this because they return pointers 28dc03343eSmckusic * to static results, so we copy the static 29dc03343eSmckusic * and return a pointer to the copy. 30dc03343eSmckusic * formal functions do this because we have to save the result 31dc03343eSmckusic * around a call to the runtime routine which restores the display, 32dc03343eSmckusic * so we can't just leave the result lying around in registers. 33*10903c71Speter * formal calls save the address of the descriptor in a local 34*10903c71Speter * temporary, so it can be addressed for the call which restores 35*10903c71Speter * the display (FRTN). 36144ba7caSpeter * calls to formal parameters pass the formal as a hidden argument 37144ba7caSpeter * to a special entry point for the formal call. 38144ba7caSpeter * [this is somewhat dependent on the way arguments are addressed.] 39dc03343eSmckusic * so PROCs and scalar FUNCs look like 40dc03343eSmckusic * p(...args...) 41dc03343eSmckusic * structure FUNCs look like 42dc03343eSmckusic * (temp = p(...args...),&temp) 43dc03343eSmckusic * formal FPROCs look like 44*10903c71Speter * ( t=p,( t -> entryaddr )(...args...,t),FRTN( t )) 45dc03343eSmckusic * formal scalar FFUNCs look like 46*10903c71Speter * ( t=p,temp=( t -> entryaddr )(...args...,t),FRTN( t ),temp) 47dc03343eSmckusic * formal structure FFUNCs look like 48*10903c71Speter * (t=p,temp = ( t -> entryaddr )(...args...,t),FRTN( t ),&temp) 49eb9f9eddSpeter */ 50eb9f9eddSpeter struct nl * 51eb9f9eddSpeter call(p, argv, porf, psbn) 52eb9f9eddSpeter struct nl *p; 53eb9f9eddSpeter int *argv, porf, psbn; 54eb9f9eddSpeter { 55eb9f9eddSpeter register struct nl *p1, *q; 56eb9f9eddSpeter int *r; 57dc03343eSmckusic struct nl *p_type_class = classify( p -> type ); 58c09f2839Smckusic bool chk = TRUE; 59eb9f9eddSpeter # ifdef PC 60dc03343eSmckusic long p_p2type = p2type( p ); 61dc03343eSmckusic long p_type_p2type = p2type( p -> type ); 62dc03343eSmckusic bool noarguments; 63dc03343eSmckusic long calltype; /* type of the call */ 64dc03343eSmckusic /* 65dc03343eSmckusic * these get used if temporaries and structures are used 66dc03343eSmckusic */ 673a2b01bfSpeter struct nl *tempnlp; 68dc03343eSmckusic long temptype; /* type of the temporary */ 69dc03343eSmckusic long p_type_width; 70dc03343eSmckusic long p_type_align; 71279fde76Speter char extname[ BUFSIZ ]; 72*10903c71Speter struct nl *tempdescrp; 73eb9f9eddSpeter # endif PC 74eb9f9eddSpeter 75eb9f9eddSpeter # ifdef OBJ 76144ba7caSpeter if (p->class == FFUNC || p->class == FPROC) { 77e0bbfc35Smckusic put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]); 78144ba7caSpeter } 79144ba7caSpeter if (porf == FUNC) { 80eb9f9eddSpeter /* 81eb9f9eddSpeter * Push some space 82eb9f9eddSpeter * for the function return type 83eb9f9eddSpeter */ 84715d7872Smckusic put(2, O_PUSH, leven(-lwidth(p->type))); 85144ba7caSpeter } 86eb9f9eddSpeter # endif OBJ 87eb9f9eddSpeter # ifdef PC 88dc03343eSmckusic /* 89*10903c71Speter * if this is a formal call, 90*10903c71Speter * stash the address of the descriptor 91*10903c71Speter * in a temporary so we can find it 92*10903c71Speter * after the FCALL for the call to FRTN 93*10903c71Speter */ 94*10903c71Speter if ( p -> class == FFUNC || p -> class == FPROC ) { 95*10903c71Speter tempdescrp = tmpalloc(sizeof( struct formalrtn *) , NIL , 96*10903c71Speter REGOK ); 97*10903c71Speter putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] , 98*10903c71Speter tempdescrp -> extra_flags , P2PTR|P2STRTY ); 99*10903c71Speter putRV( 0 , psbn , p -> value[ NL_OFFS ] , 100*10903c71Speter p -> extra_flags , P2PTR|P2STRTY ); 101*10903c71Speter putop( P2ASSIGN , P2PTR | P2STRTY ); 102*10903c71Speter } 103*10903c71Speter /* 104dc03343eSmckusic * if we have to store a temporary, 105dc03343eSmckusic * temptype will be its type, 106dc03343eSmckusic * otherwise, it's P2UNDEF. 107dc03343eSmckusic */ 108dc03343eSmckusic temptype = P2UNDEF; 109dc03343eSmckusic calltype = P2INT; 110eb9f9eddSpeter if ( porf == FUNC ) { 111dc03343eSmckusic p_type_width = width( p -> type ); 112dc03343eSmckusic switch( p_type_class ) { 113eb9f9eddSpeter case TSTR: 114eb9f9eddSpeter case TSET: 115eb9f9eddSpeter case TREC: 116eb9f9eddSpeter case TFILE: 117eb9f9eddSpeter case TARY: 118dc03343eSmckusic calltype = temptype = P2STRTY; 119dc03343eSmckusic p_type_align = align( p -> type ); 120dc03343eSmckusic break; 121dc03343eSmckusic default: 122dc03343eSmckusic if ( p -> class == FFUNC ) { 123dc03343eSmckusic calltype = temptype = p2type( p -> type ); 124eb9f9eddSpeter } 125dc03343eSmckusic break; 126dc03343eSmckusic } 127dc03343eSmckusic if ( temptype != P2UNDEF ) { 1283a2b01bfSpeter tempnlp = tmpalloc(p_type_width, p -> type, NOREG); 129dc03343eSmckusic /* 130dc03343eSmckusic * temp 131dc03343eSmckusic * for (temp = ... 132dc03343eSmckusic */ 1333a2b01bfSpeter putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] , 1343a2b01bfSpeter tempnlp -> extra_flags , temptype ); 135eb9f9eddSpeter } 136eb9f9eddSpeter } 1373ce3b4c4Speter switch ( p -> class ) { 1383ce3b4c4Speter case FUNC: 1393ce3b4c4Speter case PROC: 140dc03343eSmckusic /* 141dc03343eSmckusic * ... p( ... 142dc03343eSmckusic */ 143199b2563Speter sextname( extname , p -> symbol , BLOCKNO(p -> nl_block) ); 144eb9f9eddSpeter putleaf( P2ICON , 0 , 0 , p2type( p ) , extname ); 1453ce3b4c4Speter break; 1463ce3b4c4Speter case FFUNC: 1473ce3b4c4Speter case FPROC: 148*10903c71Speter 1493ce3b4c4Speter /* 150*10903c71Speter * ... ( t -> entryaddr )( ... 1513ce3b4c4Speter */ 152*10903c71Speter putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] , 153*10903c71Speter tempdescrp -> extra_flags , P2PTR | P2STRTY ); 154144ba7caSpeter if ( FENTRYOFFSET != 0 ) { 155144ba7caSpeter putleaf( P2ICON , FENTRYOFFSET , 0 , P2INT , 0 ); 156144ba7caSpeter putop( P2PLUS , 157144ba7caSpeter ADDTYPE( 158144ba7caSpeter ADDTYPE( ADDTYPE( p2type( p ) , P2FTN ) , 159144ba7caSpeter P2PTR ) , 160144ba7caSpeter P2PTR ) ); 161144ba7caSpeter } 162144ba7caSpeter putop( P2UNARY P2MUL , 163144ba7caSpeter ADDTYPE( ADDTYPE( p2type( p ) , P2FTN ) , P2PTR ) ); 1643ce3b4c4Speter break; 1653ce3b4c4Speter default: 1663ce3b4c4Speter panic("call class"); 1673ce3b4c4Speter } 168dc03343eSmckusic noarguments = TRUE; 169eb9f9eddSpeter # endif PC 170eb9f9eddSpeter /* 171eb9f9eddSpeter * Loop and process each of 172eb9f9eddSpeter * arguments to the proc/func. 173dc03343eSmckusic * ... ( ... args ... ) ... 174eb9f9eddSpeter */ 175c09f2839Smckusic for (p1 = plist(p); p1 != NIL; p1 = p1->chain) { 176eb9f9eddSpeter if (argv == NIL) { 177eb9f9eddSpeter error("Not enough arguments to %s", p->symbol); 178eb9f9eddSpeter return (NIL); 179eb9f9eddSpeter } 180eb9f9eddSpeter switch (p1->class) { 181eb9f9eddSpeter case REF: 182eb9f9eddSpeter /* 183eb9f9eddSpeter * Var parameter 184eb9f9eddSpeter */ 185eb9f9eddSpeter r = argv[1]; 186eb9f9eddSpeter if (r != NIL && r[0] != T_VAR) { 187eb9f9eddSpeter error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); 1881c429f41Speter chk = FALSE; 189eb9f9eddSpeter break; 190eb9f9eddSpeter } 191199b2563Speter q = lvalue( (int *) argv[1], MOD | ASGN , LREQ ); 192c09f2839Smckusic if (q == NIL) { 193c09f2839Smckusic chk = FALSE; 194eb9f9eddSpeter break; 195c09f2839Smckusic } 196eb9f9eddSpeter if (q != p1->type) { 197eb9f9eddSpeter error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); 1981c429f41Speter chk = FALSE; 199eb9f9eddSpeter break; 200eb9f9eddSpeter } 201eb9f9eddSpeter break; 202eb9f9eddSpeter case VAR: 203eb9f9eddSpeter /* 204eb9f9eddSpeter * Value parameter 205eb9f9eddSpeter */ 206eb9f9eddSpeter # ifdef OBJ 207eb9f9eddSpeter q = rvalue(argv[1], p1->type , RREQ ); 208eb9f9eddSpeter # endif OBJ 209eb9f9eddSpeter # ifdef PC 210eb9f9eddSpeter /* 211eb9f9eddSpeter * structure arguments require lvalues, 212eb9f9eddSpeter * scalars use rvalue. 213eb9f9eddSpeter */ 214eb9f9eddSpeter switch( classify( p1 -> type ) ) { 215eb9f9eddSpeter case TFILE: 216eb9f9eddSpeter case TARY: 217eb9f9eddSpeter case TREC: 218eb9f9eddSpeter case TSET: 219eb9f9eddSpeter case TSTR: 220eb9f9eddSpeter q = rvalue( argv[1] , p1 -> type , LREQ ); 221eb9f9eddSpeter break; 222eb9f9eddSpeter case TINT: 223eb9f9eddSpeter case TSCAL: 224eb9f9eddSpeter case TBOOL: 225eb9f9eddSpeter case TCHAR: 226eb9f9eddSpeter precheck( p1 -> type , "_RANG4" , "_RSNG4" ); 227eb9f9eddSpeter q = rvalue( argv[1] , p1 -> type , RREQ ); 228eb9f9eddSpeter postcheck( p1 -> type ); 229eb9f9eddSpeter break; 230eb9f9eddSpeter default: 231eb9f9eddSpeter q = rvalue( argv[1] , p1 -> type , RREQ ); 232969bd0faSpeter if ( isa( p1 -> type , "d" ) 233969bd0faSpeter && isa( q , "i" ) ) { 234969bd0faSpeter putop( P2SCONV , P2DOUBLE ); 235969bd0faSpeter } 236eb9f9eddSpeter break; 237eb9f9eddSpeter } 238eb9f9eddSpeter # endif PC 239c09f2839Smckusic if (q == NIL) { 240c09f2839Smckusic chk = FALSE; 241eb9f9eddSpeter break; 242c09f2839Smckusic } 243eb9f9eddSpeter if (incompat(q, p1->type, argv[1])) { 244eb9f9eddSpeter cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); 2451c429f41Speter chk = FALSE; 246eb9f9eddSpeter break; 247eb9f9eddSpeter } 248eb9f9eddSpeter # ifdef OBJ 249eb9f9eddSpeter if (isa(p1->type, "bcsi")) 250eb9f9eddSpeter rangechk(p1->type, q); 251eb9f9eddSpeter if (q->class != STR) 252eb9f9eddSpeter convert(q, p1->type); 253eb9f9eddSpeter # endif OBJ 254eb9f9eddSpeter # ifdef PC 255eb9f9eddSpeter switch( classify( p1 -> type ) ) { 256eb9f9eddSpeter case TFILE: 257eb9f9eddSpeter case TARY: 258eb9f9eddSpeter case TREC: 259eb9f9eddSpeter case TSET: 260eb9f9eddSpeter case TSTR: 261eb9f9eddSpeter putstrop( P2STARG 262eb9f9eddSpeter , p2type( p1 -> type ) 263eb9f9eddSpeter , lwidth( p1 -> type ) 264eb9f9eddSpeter , align( p1 -> type ) ); 265eb9f9eddSpeter } 266eb9f9eddSpeter # endif PC 267eb9f9eddSpeter break; 2683ce3b4c4Speter case FFUNC: 2693ce3b4c4Speter /* 2703ce3b4c4Speter * function parameter 2713ce3b4c4Speter */ 272c09f2839Smckusic q = flvalue( (int *) argv[1] , p1 ); 273c09f2839Smckusic chk = (chk && fcompat(q, p1)); 2743ce3b4c4Speter break; 2753ce3b4c4Speter case FPROC: 2763ce3b4c4Speter /* 2773ce3b4c4Speter * procedure parameter 2783ce3b4c4Speter */ 279c09f2839Smckusic q = flvalue( (int *) argv[1] , p1 ); 280c09f2839Smckusic chk = (chk && fcompat(q, p1)); 2813ce3b4c4Speter break; 282eb9f9eddSpeter default: 283eb9f9eddSpeter panic("call"); 284eb9f9eddSpeter } 285eb9f9eddSpeter # ifdef PC 286eb9f9eddSpeter /* 287eb9f9eddSpeter * if this is the nth (>1) argument, 288eb9f9eddSpeter * hang it on the left linear list of arguments 289eb9f9eddSpeter */ 290dc03343eSmckusic if ( noarguments ) { 291dc03343eSmckusic noarguments = FALSE; 292eb9f9eddSpeter } else { 293eb9f9eddSpeter putop( P2LISTOP , P2INT ); 294eb9f9eddSpeter } 295eb9f9eddSpeter # endif PC 296eb9f9eddSpeter argv = argv[2]; 297eb9f9eddSpeter } 298eb9f9eddSpeter if (argv != NIL) { 299eb9f9eddSpeter error("Too many arguments to %s", p->symbol); 300eb9f9eddSpeter rvlist(argv); 301eb9f9eddSpeter return (NIL); 302eb9f9eddSpeter } 303c09f2839Smckusic if (chk == FALSE) 304c09f2839Smckusic return NIL; 3053ce3b4c4Speter # ifdef OBJ 3063ce3b4c4Speter if ( p -> class == FFUNC || p -> class == FPROC ) { 307e0bbfc35Smckusic put(2, PTR_RV | psbn << 8+INDX, (int)p->value[NL_OFFS]); 308c09f2839Smckusic put(1, O_FCALL); 309715d7872Smckusic put(2, O_FRTN, even(width(p->type))); 3103ce3b4c4Speter } else { 311715d7872Smckusic put(2, O_CALL | psbn << 8, (long)p->entloc); 3123ce3b4c4Speter } 313eb9f9eddSpeter # endif OBJ 314eb9f9eddSpeter # ifdef PC 315dc03343eSmckusic /* 316144ba7caSpeter * for formal calls: add the hidden argument 317144ba7caSpeter * which is the formal struct describing the 318144ba7caSpeter * environment of the routine. 319144ba7caSpeter * and the argument which is the address of the 320144ba7caSpeter * space into which to save the display. 321144ba7caSpeter */ 322144ba7caSpeter if ( p -> class == FFUNC || p -> class == FPROC ) { 323*10903c71Speter putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] , 324*10903c71Speter tempdescrp -> extra_flags , P2PTR|P2STRTY ); 325144ba7caSpeter if ( !noarguments ) { 326144ba7caSpeter putop( P2LISTOP , P2INT ); 327144ba7caSpeter } 328144ba7caSpeter noarguments = FALSE; 329144ba7caSpeter } 330144ba7caSpeter /* 331dc03343eSmckusic * do the actual call: 332dc03343eSmckusic * either ... p( ... ) ... 333*10903c71Speter * or ... ( t -> entryaddr )( ... ) ... 334dc03343eSmckusic * and maybe an assignment. 335dc03343eSmckusic */ 336eb9f9eddSpeter if ( porf == FUNC ) { 337dc03343eSmckusic switch ( p_type_class ) { 338eb9f9eddSpeter case TBOOL: 339eb9f9eddSpeter case TCHAR: 340eb9f9eddSpeter case TINT: 341eb9f9eddSpeter case TSCAL: 342eb9f9eddSpeter case TDOUBLE: 343eb9f9eddSpeter case TPTR: 344dc03343eSmckusic putop( ( noarguments ? P2UNARY P2CALL : P2CALL ) , 345dc03343eSmckusic p_type_p2type ); 346dc03343eSmckusic if ( p -> class == FFUNC ) { 347dc03343eSmckusic putop( P2ASSIGN , p_type_p2type ); 3483ce3b4c4Speter } 349eb9f9eddSpeter break; 350eb9f9eddSpeter default: 351dc03343eSmckusic putstrop( ( noarguments ? P2UNARY P2STCALL : P2STCALL ), 352dc03343eSmckusic ADDTYPE( p_type_p2type , P2PTR ) , 353dc03343eSmckusic p_type_width , p_type_align ); 354dc03343eSmckusic putstrop( P2STASG , p_type_p2type , lwidth( p -> type ) 355eb9f9eddSpeter , align( p -> type ) ); 356eb9f9eddSpeter break; 357eb9f9eddSpeter } 358eb9f9eddSpeter } else { 359dc03343eSmckusic putop( ( noarguments ? P2UNARY P2CALL : P2CALL ) , P2INT ); 360ba9f1247Speter } 361dc03343eSmckusic /* 362*10903c71Speter * ( t=p , ... , FRTN( t ) ... 363dc03343eSmckusic */ 364715d7872Smckusic if ( p -> class == FFUNC || p -> class == FPROC ) { 365*10903c71Speter putop( P2COMOP , P2INT ); 366dc03343eSmckusic putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) , 367dc03343eSmckusic "_FRTN" ); 368*10903c71Speter putRV( 0 , cbn , tempdescrp -> value[ NL_OFFS ] , 369*10903c71Speter tempdescrp -> extra_flags , P2PTR | P2STRTY ); 370715d7872Smckusic putop( P2CALL , P2INT ); 371dc03343eSmckusic putop( P2COMOP , P2INT ); 372ba9f1247Speter } 373dc03343eSmckusic /* 374dc03343eSmckusic * if required: 375dc03343eSmckusic * either ... , temp ) 376dc03343eSmckusic * or ... , &temp ) 377dc03343eSmckusic */ 378dc03343eSmckusic if ( porf == FUNC && temptype != P2UNDEF ) { 379dc03343eSmckusic if ( temptype != P2STRTY ) { 3803a2b01bfSpeter putRV( 0 , cbn , tempnlp -> value[ NL_OFFS ] , 3813a2b01bfSpeter tempnlp -> extra_flags , p_type_p2type ); 382dc03343eSmckusic } else { 3833a2b01bfSpeter putLV( 0 , cbn , tempnlp -> value[ NL_OFFS ] , 3843a2b01bfSpeter tempnlp -> extra_flags , p_type_p2type ); 385dc03343eSmckusic } 386dc03343eSmckusic putop( P2COMOP , P2INT ); 387dc03343eSmckusic } 388dc03343eSmckusic if ( porf == PROC ) { 389eb9f9eddSpeter putdot( filename , line ); 390eb9f9eddSpeter } 391eb9f9eddSpeter # endif PC 392eb9f9eddSpeter return (p->type); 393eb9f9eddSpeter } 394eb9f9eddSpeter 395eb9f9eddSpeter rvlist(al) 396eb9f9eddSpeter register int *al; 397eb9f9eddSpeter { 398eb9f9eddSpeter 399eb9f9eddSpeter for (; al != NIL; al = al[2]) 400eb9f9eddSpeter rvalue( (int *) al[1], NLNIL , RREQ ); 401eb9f9eddSpeter } 402c09f2839Smckusic 403c09f2839Smckusic /* 404c09f2839Smckusic * check that two function/procedure namelist entries are compatible 405c09f2839Smckusic */ 406c09f2839Smckusic bool 407c09f2839Smckusic fcompat( formal , actual ) 408c09f2839Smckusic struct nl *formal; 409c09f2839Smckusic struct nl *actual; 410c09f2839Smckusic { 411c09f2839Smckusic register struct nl *f_chain; 412c09f2839Smckusic register struct nl *a_chain; 413c09f2839Smckusic bool compat = TRUE; 414c09f2839Smckusic 415c09f2839Smckusic if ( formal == NIL || actual == NIL ) { 416c09f2839Smckusic return FALSE; 417c09f2839Smckusic } 418c09f2839Smckusic for (a_chain = plist(actual), f_chain = plist(formal); 419c09f2839Smckusic f_chain != NIL; 420c09f2839Smckusic f_chain = f_chain->chain, a_chain = a_chain->chain) { 421c09f2839Smckusic if (a_chain == NIL) { 422c09f2839Smckusic error("%s %s declared on line %d has more arguments than", 423c09f2839Smckusic parnam(formal->class), formal->symbol, 424c09f2839Smckusic linenum(formal)); 425c09f2839Smckusic cerror("%s %s declared on line %d", 426c09f2839Smckusic parnam(actual->class), actual->symbol, 427c09f2839Smckusic linenum(actual)); 428c09f2839Smckusic return FALSE; 429c09f2839Smckusic } 430c09f2839Smckusic if ( a_chain -> class != f_chain -> class ) { 431c09f2839Smckusic error("%s parameter %s of %s declared on line %d is not identical", 432c09f2839Smckusic parnam(f_chain->class), f_chain->symbol, 433c09f2839Smckusic formal->symbol, linenum(formal)); 434c09f2839Smckusic cerror("with %s parameter %s of %s declared on line %d", 435c09f2839Smckusic parnam(a_chain->class), a_chain->symbol, 436c09f2839Smckusic actual->symbol, linenum(actual)); 437c09f2839Smckusic compat = FALSE; 438c09f2839Smckusic } else if (a_chain->class == FFUNC || a_chain->class == FPROC) { 439c09f2839Smckusic compat = (compat && fcompat(f_chain, a_chain)); 440c09f2839Smckusic } 441c09f2839Smckusic if ((a_chain->class != FPROC && f_chain->class != FPROC) && 442c09f2839Smckusic (a_chain->type != f_chain->type)) { 443c09f2839Smckusic error("Type of %s parameter %s of %s declared on line %d is not identical", 444c09f2839Smckusic parnam(f_chain->class), f_chain->symbol, 445c09f2839Smckusic formal->symbol, linenum(formal)); 446c09f2839Smckusic cerror("to type of %s parameter %s of %s declared on line %d", 447c09f2839Smckusic parnam(a_chain->class), a_chain->symbol, 448c09f2839Smckusic actual->symbol, linenum(actual)); 449c09f2839Smckusic compat = FALSE; 450c09f2839Smckusic } 451c09f2839Smckusic } 452c09f2839Smckusic if (a_chain != NIL) { 453c09f2839Smckusic error("%s %s declared on line %d has fewer arguments than", 454c09f2839Smckusic parnam(formal->class), formal->symbol, 455c09f2839Smckusic linenum(formal)); 456c09f2839Smckusic cerror("%s %s declared on line %d", 457c09f2839Smckusic parnam(actual->class), actual->symbol, 458c09f2839Smckusic linenum(actual)); 459c09f2839Smckusic return FALSE; 460c09f2839Smckusic } 461c09f2839Smckusic return compat; 462c09f2839Smckusic } 463c09f2839Smckusic 464c09f2839Smckusic char * 465c09f2839Smckusic parnam(nltype) 466c09f2839Smckusic int nltype; 467c09f2839Smckusic { 468c09f2839Smckusic switch(nltype) { 469c09f2839Smckusic case REF: 470c09f2839Smckusic return "var"; 471c09f2839Smckusic case VAR: 472c09f2839Smckusic return "value"; 473c09f2839Smckusic case FUNC: 474c09f2839Smckusic case FFUNC: 475c09f2839Smckusic return "function"; 476c09f2839Smckusic case PROC: 477c09f2839Smckusic case FPROC: 478c09f2839Smckusic return "procedure"; 479c09f2839Smckusic default: 480c09f2839Smckusic return "SNARK"; 481c09f2839Smckusic } 482c09f2839Smckusic } 483c09f2839Smckusic 484c09f2839Smckusic plist(p) 485c09f2839Smckusic struct nl *p; 486c09f2839Smckusic { 487c09f2839Smckusic switch (p->class) { 488c09f2839Smckusic case FFUNC: 489c09f2839Smckusic case FPROC: 490c09f2839Smckusic return p->ptr[ NL_FCHAIN ]; 491c09f2839Smckusic case PROC: 492c09f2839Smckusic case FUNC: 493c09f2839Smckusic return p->chain; 494c09f2839Smckusic default: 495c09f2839Smckusic panic("plist"); 496c09f2839Smckusic } 497c09f2839Smckusic } 498c09f2839Smckusic 499c09f2839Smckusic linenum(p) 500c09f2839Smckusic struct nl *p; 501c09f2839Smckusic { 502c09f2839Smckusic if (p->class == FUNC) 503c09f2839Smckusic return p->ptr[NL_FVAR]->value[NL_LINENO]; 504c09f2839Smckusic return p->value[NL_LINENO]; 505c09f2839Smckusic } 506