|
|
1.1 ! root 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 November 1978 ! 8: */ ! 9: ! 10: #include "whoami" ! 11: #include "0.h" ! 12: #include "tree.h" ! 13: #include "opcode.h" ! 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: if (porf == FUNC) ! 33: /* ! 34: * Push some space ! 35: * for the function return type ! 36: */ ! 37: put2(O_PUSH, even(-width(p->type))); ! 38: /* ! 39: * Loop and process each of ! 40: * arguments to the proc/func. ! 41: */ ! 42: for (p1 = p->chain; p1 != NIL; p1 = p1->chain) { ! 43: if (argv == NIL) { ! 44: error("Not enough arguments to %s", p->symbol); ! 45: return (NIL); ! 46: } ! 47: switch (p1->class) { ! 48: case REF: ! 49: /* ! 50: * Var parameter ! 51: */ ! 52: r = argv[1]; ! 53: if (r != NIL && r[0] != T_VAR) { ! 54: error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol); ! 55: break; ! 56: } ! 57: q = lvalue( (int *) argv[1], MOD); ! 58: if (q == NIL) ! 59: break; ! 60: if (q != p1->type) { ! 61: error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol); ! 62: break; ! 63: } ! 64: break; ! 65: case VAR: ! 66: /* ! 67: * Value parameter ! 68: */ ! 69: q = rvalue(argv[1], p1->type); ! 70: if (q == NIL) ! 71: break; ! 72: if (incompat(q, p1->type, argv[1])) { ! 73: cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol); ! 74: break; ! 75: } ! 76: if (isa(p1->type, "bcsi")) ! 77: rangechk(p1->type, q); ! 78: if (q->class != STR) ! 79: convert(q, p1->type); ! 80: break; ! 81: default: ! 82: panic("call"); ! 83: } ! 84: argv = argv[2]; ! 85: } ! 86: if (argv != NIL) { ! 87: error("Too many arguments to %s", p->symbol); ! 88: rvlist(argv); ! 89: return (NIL); ! 90: } ! 91: put2(O_CALL | psbn << 9, p->entloc); ! 92: put2(O_POP, p->value[NL_OFFS]-DPOFF2); ! 93: return (p->type); ! 94: } ! 95: ! 96: rvlist(al) ! 97: register int *al; ! 98: { ! 99: ! 100: for (; al != NIL; al = al[2]) ! 101: rvalue( (int *) al[1], NLNIL); ! 102: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.