Return to pclval.c CVS log

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

Annotation of 40BSD/cmd/pi/pclval.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)pclval.c 1.1 8/27/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:        /*
        !            12:         *      and the rest of the file
        !            13:         */
        !            14: #   include    "pc.h"
        !            15: #   include    "pcops.h"
        !            16: 
        !            17: extern int flagwas;
        !            18: /*
        !            19:  * pclvalue computes the address
        !            20:  * of a qualified name and
        !            21:  * leaves it on the stack.
        !            22:  * for pc, it can be asked for either an lvalue or an rvalue.
        !            23:  * the semantics are the same, only the code is different.
        !            24:  * for putting out calls to check for nil and fnil,
        !            25:  * we have to traverse the list of qualifications twice:
        !            26:  * once to put out the calls and once to put out the address to be checked.
        !            27:  */
        !            28: struct nl *
        !            29: pclvalue( r , modflag , required )
        !            30:        int     *r;
        !            31:        int     modflag;
        !            32:        int     required;
        !            33: {
        !            34:        register struct nl      *p;
        !            35:        register                *c, *co;
        !            36:        int                     f, o;
        !            37:        int                     tr[2], trp[3];
        !            38:        struct nl               *firstp;
        !            39:        struct nl               *lastp;
        !            40:        char                    *firstsymbol;
        !            41:        int                     firstbn;
        !            42: 
        !            43:        if ( r == NIL ) {
        !            44:                return NIL;
        !            45:        }
        !            46:        if ( nowexp( r ) ) {
        !            47:                return NIL;
        !            48:        }
        !            49:        if ( r[0] != T_VAR ) {
        !            50:                error("Variable required");     /* Pass mesgs down from pt of call ? */
        !            51:                return NIL;
        !            52:        }
        !            53:        firstp = p = lookup( r[2] );
        !            54:        if ( p == NIL ) {
        !            55:                return NIL;
        !            56:        }
        !            57:        firstsymbol = p -> symbol;
        !            58:        firstbn = bn;
        !            59:        c = r[3];
        !            60:        if ( ( modflag & NOUSE ) && ! lptr( c ) ) {
        !            61:                p -> nl_flags = flagwas;
        !            62:        }
        !            63:        if ( modflag & MOD ) {
        !            64:                p -> nl_flags |= NMOD;
        !            65:        }
        !            66:        /*
        !            67:         * Only possibilities for p -> class here
        !            68:         * are the named classes, i.e. CONST, TYPE
        !            69:         * VAR, PROC, FUNC, REF, or a WITHPTR.
        !            70:         */
        !            71:        if ( p -> class == WITHPTR ) {
        !            72:                /*
        !            73:                 * Construct the tree implied by
        !            74:                 * the with statement
        !            75:                 */
        !            76:            trp[0] = T_LISTPP;
        !            77:            trp[1] = tr;
        !            78:            trp[2] = r[3];
        !            79:            tr[0] = T_FIELD;
        !            80:            tr[1] = r[2];
        !            81:            c = trp;
        !            82:        }
        !            83:            /*
        !            84:             *  this not only puts out the names of functions to call
        !            85:             *  but also does all the semantic checking of the qualifications.
        !            86:             */
        !            87:        if ( ! nilfnil( p , c , modflag , firstp , r[2] ) ) {
        !            88:            return NIL;
        !            89:        }
        !            90:        switch (p -> class) {
        !            91:                case WITHPTR:
        !            92:                case REF:
        !            93:                        /*
        !            94:                         * Obtain the indirect word
        !            95:                         * of the WITHPTR or REF
        !            96:                         * as the base of our lvalue
        !            97:                         */
        !            98:                        putRV( firstsymbol , firstbn , p -> value[ 0 ]
        !            99:                                    , p2type( p ) );
        !           100:                        firstsymbol = 0;
        !           101:                        f = 0;          /* have an lv on stack */
        !           102:                        o = 0;
        !           103:                        break;
        !           104:                case VAR:
        !           105:                        f = 1;          /* no lv on stack yet */
        !           106:                        o = p -> value[0];
        !           107:                        break;
        !           108:                default:
        !           109:                        error("%s %s found where variable required", classes[p -> class], p -> symbol);
        !           110:                        return (NIL);
        !           111:        }
        !           112:        /*
        !           113:         * Loop and handle each
        !           114:         * qualification on the name
        !           115:         */
        !           116:        if ( c == NIL && ( modflag & ASGN ) && p -> value[ NL_FORV ] ) {
        !           117:                error("Can't modify the for variable %s in the range of the loop", p -> symbol);
        !           118:                return (NIL);
        !           119:        }
        !           120:        for ( ; c != NIL ; c = c[2] ) {
        !           121:                co = c[1];
        !           122:                if ( co == NIL ) {
        !           123:                        return NIL;
        !           124:                }
        !           125:                lastp = p;
        !           126:                p = p -> type;
        !           127:                if ( p == NIL ) {
        !           128:                        return NIL;
        !           129:                }
        !           130:                switch ( co[0] ) {
        !           131:                        case T_PTR:
        !           132:                                /*
        !           133:                                 * Pointer qualification.
        !           134:                                 */
        !           135:                                if ( f ) {
        !           136:                                        putLV( firstsymbol , firstbn , o
        !           137:                                               , p2type( p ) );
        !           138:                                        firstsymbol = 0;
        !           139:                                } else {
        !           140:                                        if (o) {
        !           141:                                            putleaf( P2ICON , o , 0 , P2INT
        !           142:                                                    , 0 );
        !           143:                                            putop( P2PLUS , P2PTR | P2CHAR );
        !           144:                                        }
        !           145:                                }
        !           146:                                    /*
        !           147:                                     * Pointer cannot be
        !           148:                                     * nil and file cannot
        !           149:                                     * be at end-of-file.
        !           150:                                     * the appropriate function name is 
        !           151:                                     * already out there from nilfnil.
        !           152:                                     */
        !           153:                                if ( p -> class == PTR ) {
        !           154:                                        /*
        !           155:                                         * this is the indirection from
        !           156:                                         * the address of the pointer 
        !           157:                                         * to the pointer itself.
        !           158:                                         * kirk sez:
        !           159:                                         * fnil doesn't want this.
        !           160:                                         * and does it itself for files
        !           161:                                         * since only it knows where the
        !           162:                                         * actual window is.
        !           163:                                         * but i have to do this for
        !           164:                                         * regular pointers.
        !           165:                                         */
        !           166:                                    putop( P2UNARY P2MUL , p2type( p ) );
        !           167:                                    if ( opt( 't' ) ) {
        !           168:                                        putop( P2CALL , P2INT );
        !           169:                                    }
        !           170:                                } else {
        !           171:                                    putop( P2CALL , P2INT );
        !           172:                                }
        !           173:                                f = o = 0;
        !           174:                                continue;
        !           175:                        case T_ARGL:
        !           176:                        case T_ARY:
        !           177:                                if ( f ) {
        !           178:                                        putLV( firstsymbol , firstbn , o
        !           179:                                                , p2type( p ) );
        !           180:                                        firstsymbol = 0;
        !           181:                                } else {
        !           182:                                        if (o) {
        !           183:                                            putleaf( P2ICON , o , 0 , P2INT
        !           184:                                                    , 0 );
        !           185:                                            putop( P2PLUS , P2INT );
        !           186:                                        }
        !           187:                                }
        !           188:                                arycod( p , co[1] );
        !           189:                                f = o = 0;
        !           190:                                continue;
        !           191:                        case T_FIELD:
        !           192:                                /*
        !           193:                                 * Field names are just
        !           194:                                 * an offset with some 
        !           195:                                 * semantic checking.
        !           196:                                 */
        !           197:                                p = reclook(p, co[1]);
        !           198:                                o += p -> value[0];
        !           199:                                continue;
        !           200:                        default:
        !           201:                                panic("lval2");
        !           202:                }
        !           203:        }
        !           204:        if (f) {
        !           205:                putLV( firstsymbol , firstbn , o , p2type( p -> type ) );
        !           206:        } else {
        !           207:                if (o) {
        !           208:                    putleaf( P2ICON , o , 0 , P2INT , 0 );
        !           209:                    putop( P2PLUS , P2INT );
        !           210:                }
        !           211:        }
        !           212:        if ( required == RREQ ) {
        !           213:            putop( P2UNARY P2MUL , p2type( p -> type ) );
        !           214:        }
        !           215:        return ( p -> type );
        !           216: }
        !           217: 
        !           218:     /*
        !           219:      * this recursively follows done a list of qualifications
        !           220:      * and puts out the beginnings of calls to fnil for files
        !           221:      * or nil for pointers (if checking is on) on the way back.
        !           222:      * this returns true or false.
        !           223:      */
        !           224: nilfnil( p , c , modflag , firstp , r2 )
        !           225:     struct nl  *p;
        !           226:     int                *c;
        !           227:     int                modflag;
        !           228:     struct nl  *firstp;
        !           229:     char       *r2;            /* no, not r2-d2 */
        !           230:     {
        !           231:        int             *co;
        !           232:        struct nl       *lastp;
        !           233:        int             t;
        !           234: 
        !           235:        if ( c == NIL ) {
        !           236:            return TRUE;
        !           237:        }
        !           238:        co = (int *) ( c[1] );
        !           239:        if ( co == NIL ) {
        !           240:                return FALSE;
        !           241:        }
        !           242:        lastp = p;
        !           243:        p = p -> type;
        !           244:        if ( p == NIL ) {
        !           245:                return FALSE;
        !           246:        }
        !           247:        switch ( co[0] ) {
        !           248:            case T_PTR:
        !           249:                    /*
        !           250:                     * Pointer qualification.
        !           251:                     */
        !           252:                    lastp -> nl_flags |= NUSED;
        !           253:                    if ( p -> class != PTR && p -> class != FILET) {
        !           254:                            error("^ allowed only on files and pointers, not on %ss", nameof(p));
        !           255:                            goto bad;
        !           256:                    }
        !           257:                    break;
        !           258:            case T_ARGL:
        !           259:                    if ( p -> class != ARRAY ) {
        !           260:                            if ( lastp == firstp ) {
        !           261:                                    error("%s is a %s, not a function", r2, classes[firstp -> class]);
        !           262:                            } else {
        !           263:                                    error("Illegal function qualificiation");
        !           264:                            }
        !           265:                            return FALSE;
        !           266:                    }
        !           267:                    recovered();
        !           268:                    error("Pascal uses [] for subscripting, not ()");
        !           269:                    /* and fall through */
        !           270:            case T_ARY:
        !           271:                    if ( p -> class != ARRAY ) {
        !           272:                            error("Subscripting allowed only on arrays, not on %ss", nameof(p));
        !           273:                            goto bad;
        !           274:                    }
        !           275:                    codeoff();
        !           276:                    t = arycod( p , co[1] );
        !           277:                    codeon();
        !           278:                    switch ( t ) {
        !           279:                            case 0:
        !           280:                                    return FALSE;
        !           281:                            case -1:
        !           282:                                    goto bad;
        !           283:                    }
        !           284:                    break;
        !           285:            case T_FIELD:
        !           286:                    /*
        !           287:                     * Field names are just
        !           288:                     * an offset with some 
        !           289:                     * semantic checking.
        !           290:                     */
        !           291:                    if ( p -> class != RECORD ) {
        !           292:                            error(". allowed only on records, not on %ss", nameof(p));
        !           293:                            goto bad;
        !           294:                    }
        !           295:                    if ( co[1] == NIL ) {
        !           296:                            return FALSE;
        !           297:                    }
        !           298:                    p = reclook( p , co[1] );
        !           299:                    if ( p == NIL ) {
        !           300:                            error("%s is not a field in this record", co[1]);
        !           301:                            goto bad;
        !           302:                    }
        !           303:                    if ( modflag & MOD ) {
        !           304:                            p -> nl_flags |= NMOD;
        !           305:                    }
        !           306:                    if ( ( modflag & NOUSE ) == 0 || lptr( c[2] ) ) {
        !           307:                            p -> nl_flags |= NUSED;
        !           308:                    }
        !           309:                    break;
        !           310:            default:
        !           311:                    panic("nilfnil");
        !           312:        }
        !           313:            /*
        !           314:             *  recursive call, check the rest of the qualifications.
        !           315:             */
        !           316:        if ( ! nilfnil( p , c[2] , modflag , firstp , r2 ) ) {
        !           317:            return FALSE;
        !           318:        }
        !           319:            /*
        !           320:             *  the point of all this.
        !           321:             */
        !           322:        if ( co[0] == T_PTR ) {
        !           323:            if ( p -> class == PTR ) {
        !           324:                    if ( opt( 't' ) ) {
        !           325:                        putleaf( P2ICON , 0 , 0
        !           326:                            , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           327:                            , "_NIL" );
        !           328:                    }
        !           329:            } else {
        !           330:                    putleaf( P2ICON , 0 , 0
        !           331:                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           332:                        , "_FNIL" );
        !           333:            }
        !           334:        }
        !           335:        return TRUE;
        !           336: bad:
        !           337:        cerror("Error occurred on qualification of %s", r2);
        !           338:        return FALSE;
        !           339:     }
        !           340: #endif PC

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