|
|
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.