2.9BSD - /usr/src/ucb/pascal/pi/call.c

   1: /*	@(#)call.c	2.2	SCCS id keyword	*/
   2: /* Copyright (c) 1979 Regents of the University of California */
   3: #
   4: /*
   5:  * pi - Pascal interpreter code translator
   6:  *
   7:  * Charles Haley, Bill Joy UCB
   8:  * Version 1.2 November 1978
   9:  */
  10: 
  11: #include "whoami"
  12: #include "0.h"
  13: #include "tree.h"
  14: #include "opcode.h"
  15: 
  16: /*
  17:  * Call generates code for calls to
  18:  * user defined procedures and functions
  19:  * and is called by proc and funccod.
  20:  * P is the result of the lookup
  21:  * of the procedure/function symbol,
  22:  * and porf is PROC or FUNC.
  23:  * Psbn is the block number of p.
  24:  */
  25: struct nl *
  26: call(p, argv, porf, psbn)
  27:     struct nl *p;
  28:     int *argv, porf, psbn;
  29: {
  30:     register struct nl *p1, *q;
  31:     int *r;
  32: 
  33:     if (porf == FUNC)
  34:         /*
  35: 		 * Push some space
  36: 		 * for the function return type
  37: 		 */
  38:         put2(O_PUSH, even(-width(p->type)));
  39:     /*
  40: 	 * Loop and process each of
  41: 	 * arguments to the proc/func.
  42: 	 */
  43:     for (p1 = p->chain; p1 != NIL; p1 = p1->chain) {
  44:         if (argv == NIL) {
  45:             error("Not enough arguments to %s", p->symbol);
  46:             return (NIL);
  47:         }
  48:         switch (p1->class) {
  49:             case REF:
  50:                 /*
  51: 				 * Var parameter
  52: 				 */
  53:                 r = argv[1];
  54:                 if (r != NIL && r[0] != T_VAR) {
  55:                     error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
  56:                     break;
  57:                 }
  58:                 q = lvalue( (int *) argv[1], MOD);
  59:                 if (q == NIL)
  60:                     break;
  61:                 if (q != p1->type) {
  62:                     error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
  63:                     break;
  64:                 }
  65:                 break;
  66:             case VAR:
  67:                 /*
  68: 				 * Value parameter
  69: 				 */
  70:                 q = rvalue(argv[1], p1->type);
  71:                 if (q == NIL)
  72:                     break;
  73:                 if (incompat(q, p1->type, argv[1])) {
  74:                     cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
  75:                     break;
  76:                 }
  77:                 if (isa(p1->type, "bcsi"))
  78:                     rangechk(p1->type, q);
  79:                 if (q->class != STR)
  80:                     convert(q, p1->type);
  81:                 break;
  82:             default:
  83:                 panic("call");
  84:         }
  85:         argv = argv[2];
  86:     }
  87:     if (argv != NIL) {
  88:         error("Too many arguments to %s", p->symbol);
  89:         rvlist(argv);
  90:         return (NIL);
  91:     }
  92:     put2(O_CALL | psbn << 9, p->value[NL_LOC]);
  93:     put2(O_POP, p->value[NL_OFFS]-DPOFF2);
  94:     return (p->type);
  95: }
  96: 
  97: rvlist(al)
  98:     register int *al;
  99: {
 100: 
 101:     for (; al != NIL; al = al[2])
 102:         rvalue( (int *) al[1], NLNIL);
 103: }

Defined functions