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