Annotation of 3BSD/cmd/pi/call.c, revision 1.1.1.1

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: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.