Return to call.c CVS log

Up to [CSRG BSD Unix] / 41BSD / cmd / pi

Annotation of 41BSD/cmd/pi/call.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)call.c 1.3 10/2/80";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #include "0.h"
        !             7: #include "tree.h"
        !             8: #include "opcode.h"
        !             9: #include "objfmt.h"
        !            10: #ifdef PC
        !            11: #   include "pc.h"
        !            12: #   include "pcops.h"
        !            13: #endif PC
        !            14: 
        !            15: bool   slenflag = 0;
        !            16: bool   floatflag = 0;
        !            17: 
        !            18: /*
        !            19:  * Call generates code for calls to
        !            20:  * user defined procedures and functions
        !            21:  * and is called by proc and funccod.
        !            22:  * P is the result of the lookup
        !            23:  * of the procedure/function symbol,
        !            24:  * and porf is PROC or FUNC.
        !            25:  * Psbn is the block number of p.
        !            26:  */
        !            27: struct nl *
        !            28: call(p, argv, porf, psbn)
        !            29:        struct nl *p;
        !            30:        int *argv, porf, psbn;
        !            31: {
        !            32:        register struct nl *p1, *q;
        !            33:        int *r;
        !            34: 
        !            35: #      ifdef OBJ
        !            36:            int         cnt;
        !            37: #      endif OBJ
        !            38: #      ifdef PC
        !            39:            long        temp;
        !            40:            int         firsttime;
        !            41:            int         rettype;
        !            42: #      endif PC
        !            43: 
        !            44: #      ifdef OBJ
        !            45:            if (p->class == FFUNC || p->class == FPROC)
        !            46:                put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]);
        !            47:            if (porf == FUNC)
        !            48:                    /*
        !            49:                     * Push some space
        !            50:                     * for the function return type
        !            51:                     */
        !            52:                    put2(O_PUSH, even(-width(p->type)));
        !            53: #      endif OBJ
        !            54: #      ifdef PC
        !            55:            if ( porf == FUNC ) {
        !            56:                switch( classify( p -> type ) ) {
        !            57:                    case TSTR:
        !            58:                    case TSET:
        !            59:                    case TREC:
        !            60:                    case TFILE:
        !            61:                    case TARY:
        !            62:                        temp = sizes[ cbn ].om_off -= width( p -> type );
        !            63:                        putlbracket( ftnno , -sizes[cbn].om_off );
        !            64:                        if (sizes[cbn].om_off < sizes[cbn].om_max) {
        !            65:                                sizes[cbn].om_max = sizes[cbn].om_off;
        !            66:                        }
        !            67:                        putRV( 0 , cbn , temp , P2STRTY );
        !            68:                }
        !            69:            }
        !            70:            switch ( p -> class ) {
        !            71:                case FUNC:
        !            72:                case PROC:
        !            73:                    {
        !            74:                        char    extname[ BUFSIZ ];
        !            75:                        char    *starthere;
        !            76:                        int     funcbn;
        !            77:                        int     i;
        !            78: 
        !            79:                        starthere = &extname[0];
        !            80:                        funcbn = p -> nl_block & 037;
        !            81:                        for ( i = 1 ; i < funcbn ; i++ ) {
        !            82:                            sprintf( starthere , EXTFORMAT , enclosing[ i ] );
        !            83:                            starthere += strlen( enclosing[ i ] ) + 1;
        !            84:                        }
        !            85:                        sprintf( starthere , EXTFORMAT , p -> symbol );
        !            86:                        starthere += strlen( p -> symbol ) + 1;
        !            87:                        if ( starthere >= &extname[ BUFSIZ ] ) {
        !            88:                            panic( "call namelength" );
        !            89:                        }
        !            90:                        putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
        !            91:                    }
        !            92:                    break;
        !            93:                case FFUNC:
        !            94:                case FPROC:
        !            95:                            /*
        !            96:                             *  start one of these:
        !            97:                             *  FRTN( frtn , ( *FCALL( frtn ) )(...args...) )
        !            98:                             */
        !            99:                        putleaf( P2ICON , 0 , 0 , p2type( p ) , "_FRTN" );
        !           100:                        putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY );
        !           101:                        putleaf( P2ICON , 0 , 0
        !           102:                            , ADDTYPE( P2PTR , ADDTYPE( P2FTN , p2type( p ) ) )
        !           103:                            , "_FCALL" );
        !           104:                        putRV( 0 , cbn , p -> value[NL_OFFS] , P2PTR|P2STRTY );
        !           105:                        putop( P2CALL , p2type( p ) );
        !           106:                        break;
        !           107:                default:
        !           108:                        panic("call class");
        !           109:            }
        !           110:            firsttime = TRUE;
        !           111: #      endif PC
        !           112:        /*
        !           113:         * Loop and process each of
        !           114:         * arguments to the proc/func.
        !           115:         */
        !           116:        if ( p -> class == FUNC || p -> class == PROC ) {
        !           117:            for (p1 = p->chain; p1 != NIL; p1 = p1->chain) {
        !           118:                if (argv == NIL) {
        !           119:                        error("Not enough arguments to %s", p->symbol);
        !           120:                        return (NIL);
        !           121:                }
        !           122:                switch (p1->class) {
        !           123:                    case REF:
        !           124:                            /*
        !           125:                             * Var parameter
        !           126:                             */
        !           127:                            r = argv[1];
        !           128:                            if (r != NIL && r[0] != T_VAR) {
        !           129:                                    error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
        !           130:                                    break;
        !           131:                            }
        !           132:                            q = lvalue( (int *) argv[1], MOD , LREQ );
        !           133:                            if (q == NIL)
        !           134:                                    break;
        !           135:                            if (q != p1->type) {
        !           136:                                    error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
        !           137:                                    break;
        !           138:                            }
        !           139:                            break;
        !           140:                    case VAR:
        !           141:                            /*
        !           142:                             * Value parameter
        !           143:                             */
        !           144: #                      ifdef OBJ
        !           145:                                q = rvalue(argv[1], p1->type , RREQ );
        !           146: #                      endif OBJ
        !           147: #                      ifdef PC
        !           148:                                    /*
        !           149:                                     * structure arguments require lvalues,
        !           150:                                     * scalars use rvalue.
        !           151:                                     */
        !           152:                                switch( classify( p1 -> type ) ) {
        !           153:                                    case TFILE:
        !           154:                                    case TARY:
        !           155:                                    case TREC:
        !           156:                                    case TSET:
        !           157:                                    case TSTR:
        !           158:                                        q = rvalue( argv[1] , p1 -> type , LREQ );
        !           159:                                        break;
        !           160:                                    case TINT:
        !           161:                                    case TSCAL:
        !           162:                                    case TBOOL:
        !           163:                                    case TCHAR:
        !           164:                                        precheck( p1 -> type , "_RANG4" , "_RSNG4" );
        !           165:                                        q = rvalue( argv[1] , p1 -> type , RREQ );
        !           166:                                        postcheck( p1 -> type );
        !           167:                                        break;
        !           168:                                    default:
        !           169:                                        q = rvalue( argv[1] , p1 -> type , RREQ );
        !           170:                                        if (  isa( p1 -> type  , "d" )
        !           171:                                           && isa( q , "i" ) ) {
        !           172:                                            putop( P2SCONV , P2DOUBLE );
        !           173:                                        }
        !           174:                                        break;
        !           175:                                }
        !           176: #                      endif PC
        !           177:                            if (q == NIL)
        !           178:                                    break;
        !           179:                            if (incompat(q, p1->type, argv[1])) {
        !           180:                                    cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
        !           181:                                    break;
        !           182:                            }
        !           183: #                      ifdef OBJ
        !           184:                                if (isa(p1->type, "bcsi"))
        !           185:                                        rangechk(p1->type, q);
        !           186:                                if (q->class != STR)
        !           187:                                        convert(q, p1->type);
        !           188: #                      endif OBJ
        !           189: #                      ifdef PC
        !           190:                                switch( classify( p1 -> type ) ) {
        !           191:                                    case TFILE:
        !           192:                                    case TARY:
        !           193:                                    case TREC:
        !           194:                                    case TSET:
        !           195:                                    case TSTR:
        !           196:                                            putstrop( P2STARG
        !           197:                                                , p2type( p1 -> type )
        !           198:                                                , lwidth( p1 -> type )
        !           199:                                                , align( p1 -> type ) );
        !           200:                                }
        !           201: #                      endif PC
        !           202:                            break;
        !           203:                    case FFUNC:
        !           204:                            /*
        !           205:                             * function parameter
        !           206:                             */
        !           207:                            q = flvalue( (int *) argv[1] , FFUNC );
        !           208:                            if (q == NIL)
        !           209:                                    break;
        !           210:                            if (q != p1->type) {
        !           211:                                    error("Function type not identical to type of function parameter %s of %s", p1->symbol, p->symbol);
        !           212:                                    break;
        !           213:                            }
        !           214:                            break;
        !           215:                    case FPROC:
        !           216:                            /*
        !           217:                             * procedure parameter
        !           218:                             */
        !           219:                            q = flvalue( (int *) argv[1] , FPROC );
        !           220:                            if (q != NIL) {
        !           221:                                    error("Procedure parameter %s of %s cannot have a type", p1->symbol, p->symbol);
        !           222:                            }
        !           223:                            break;
        !           224:                    default:
        !           225:                            panic("call");
        !           226:                }
        !           227: #          ifdef PC
        !           228:                        /*
        !           229:                         *      if this is the nth (>1) argument,
        !           230:                         *      hang it on the left linear list of arguments
        !           231:                         */
        !           232:                    if ( firsttime ) {
        !           233:                            firsttime = FALSE;
        !           234:                    } else {
        !           235:                            putop( P2LISTOP , P2INT );
        !           236:                    }
        !           237: #          endif PC
        !           238:                argv = argv[2];
        !           239:            }
        !           240:            if (argv != NIL) {
        !           241:                    error("Too many arguments to %s", p->symbol);
        !           242:                    rvlist(argv);
        !           243:                    return (NIL);
        !           244:            }
        !           245:        } else if ( p -> class == FFUNC || p -> class == FPROC ) {
        !           246:                /*
        !           247:                 *      formal routines can only have by-value parameters.
        !           248:                 *      this will lose for integer actuals passed to real
        !           249:                 *      formals, and strings which people want blank padded.
        !           250:                 */
        !           251: #          ifdef OBJ
        !           252:                cnt = 0;
        !           253: #          endif OBJ
        !           254:            for ( ; argv != NIL ; argv = argv[2] ) {
        !           255: #              ifdef OBJ
        !           256:                    q = rvalue(argv[1], NIL, RREQ );
        !           257:                    cnt += even(lwidth(q));
        !           258: #              endif OBJ
        !           259: #              ifdef PC
        !           260:                        /*
        !           261:                         * structure arguments require lvalues,
        !           262:                         * scalars use rvalue.
        !           263:                         */
        !           264:                    codeoff();
        !           265:                    p1 = rvalue( argv[1] , NIL , RREQ );
        !           266:                    codeon();
        !           267:                    switch( classify( p1 ) ) {
        !           268:                        case TSTR:
        !           269:                            if ( p1 -> class == STR && slenflag == 0 ) {
        !           270:                                if ( opt( 's' ) ) {
        !           271:                                    standard();
        !           272:                                } else {
        !           273:                                    warning();
        !           274:                                }
        !           275:                                error("Implementation can't construct equal length strings");
        !           276:                                slenflag++;
        !           277:                            }
        !           278:                            /* and fall through */
        !           279:                        case TFILE:
        !           280:                        case TARY:
        !           281:                        case TREC:
        !           282:                        case TSET:
        !           283:                            q = rvalue( argv[1] , p1 , LREQ );
        !           284:                            break;
        !           285:                        case TINT:
        !           286:                            if ( floatflag == 0 ) {
        !           287:                                if ( opt( 's' ) ) {
        !           288:                                    standard();
        !           289:                                } else {
        !           290:                                    warning();
        !           291:                                }
        !           292:                                error("Implementation can't coerice integer to real");
        !           293:                                floatflag++;
        !           294:                            }
        !           295:                            /* and fall through */
        !           296:                        case TSCAL:
        !           297:                        case TBOOL:
        !           298:                        case TCHAR:
        !           299:                        default:
        !           300:                            q = rvalue( argv[1] , p1 , RREQ );
        !           301:                            break;
        !           302:                    }
        !           303:                    switch( classify( p1 ) ) {
        !           304:                        case TFILE:
        !           305:                        case TARY:
        !           306:                        case TREC:
        !           307:                        case TSET:
        !           308:                        case TSTR:
        !           309:                                putstrop( P2STARG , p2type( p1 ) ,
        !           310:                                    lwidth( p1 ) , align( p1 ) );
        !           311:                    }
        !           312:                        /*
        !           313:                         *      if this is the nth (>1) argument,
        !           314:                         *      hang it on the left linear list of arguments
        !           315:                         */
        !           316:                    if ( firsttime ) {
        !           317:                            firsttime = FALSE;
        !           318:                    } else {
        !           319:                            putop( P2LISTOP , P2INT );
        !           320:                    }
        !           321: #              endif PC
        !           322:            }
        !           323:        } else {
        !           324:            panic("call class");
        !           325:        }
        !           326: #      ifdef OBJ
        !           327:            if ( p -> class == FFUNC || p -> class == FPROC ) {
        !           328:                put(2, PTR_RV | cbn << 8+INDX, p->value[NL_OFFS]);
        !           329:                put(2, O_FCALL, cnt);
        !           330:                put(2, O_FRTN, even(lwidth(p->type)));
        !           331:            } else {
        !           332:                put2(O_CALL | psbn << 8+INDX, p->entloc);
        !           333:            }
        !           334: #      endif OBJ
        !           335: #      ifdef PC
        !           336:            if ( porf == FUNC ) {
        !           337:                rettype = p2type( p -> type );
        !           338:                switch ( classify( p -> type ) ) {
        !           339:                    case TBOOL:
        !           340:                    case TCHAR:
        !           341:                    case TINT:
        !           342:                    case TSCAL:
        !           343:                    case TDOUBLE:
        !           344:                    case TPTR:
        !           345:                        if ( firsttime ) {
        !           346:                                putop( P2UNARY P2CALL , rettype );
        !           347:                        } else {
        !           348:                                putop( P2CALL , rettype );
        !           349:                        }
        !           350:                        if (p -> class == FFUNC || p -> class == FPROC ) {
        !           351:                            putop( P2LISTOP , P2INT );
        !           352:                            putop( P2CALL , rettype );
        !           353:                        }
        !           354:                        break;
        !           355:                    default:
        !           356:                        if ( firsttime ) {
        !           357:                                putstrop( P2UNARY P2STCALL
        !           358:                                        , ADDTYPE( rettype , P2PTR )
        !           359:                                        , lwidth( p -> type )
        !           360:                                        , align( p -> type ) );
        !           361:                        } else {
        !           362:                                putstrop( P2STCALL
        !           363:                                        , ADDTYPE( rettype , P2PTR )
        !           364:                                        , lwidth( p -> type )
        !           365:                                        , align( p -> type ) );
        !           366:                        }
        !           367:                        if (p -> class == FFUNC || p -> class == FPROC ) {
        !           368:                            putop( P2LISTOP , P2INT );
        !           369:                            putop( P2CALL , ADDTYPE( rettype , P2PTR ) );
        !           370:                        }
        !           371:                        putstrop( P2STASG , rettype , lwidth( p -> type )
        !           372:                                , align( p -> type ) );
        !           373:                        putLV( 0 , cbn , temp , rettype );
        !           374:                        putop( P2COMOP , P2INT );
        !           375:                        break;
        !           376:                }
        !           377:            } else {
        !           378:                if ( firsttime ) {
        !           379:                        putop( P2UNARY P2CALL , P2INT );
        !           380:                } else {
        !           381:                        putop( P2CALL , P2INT );
        !           382:                }
        !           383:                if (p -> class == FFUNC || p -> class == FPROC ) {
        !           384:                    putop( P2LISTOP , P2INT );
        !           385:                    putop( P2CALL , P2INT );
        !           386:                }
        !           387:                putdot( filename , line );
        !           388:            }
        !           389: #      endif PC
        !           390:        return (p->type);
        !           391: }
        !           392: 
        !           393: rvlist(al)
        !           394:        register int *al;
        !           395: {
        !           396: 
        !           397:        for (; al != NIL; al = al[2])
        !           398:                rvalue( (int *) al[1], NLNIL , RREQ );
        !           399: }

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