Return to b2syn.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall

Annotation of 43BSD/contrib/B/src/bsmall/b2syn.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
        !             2: /* $Header: b2syn.c,v 1.1 84/06/28 00:49:21 timo Exp $ */
        !             3: 
        !             4: /* General parsing routines for B interpreter */
        !             5: #include "b.h"
        !             6: #include "b1obj.h"
        !             7: #include "b0con.h" /*for CLEAR_EOF*/
        !             8: #include "b2env.h"
        !             9: #include "b2scr.h"
        !            10: #include "b2syn.h"
        !            11: 
        !            12: Visible Procedure upto(q, ff) txptr q; string ff; {
        !            13:        Skipsp(tx);
        !            14:        if (tx < q) parerr("something unexpected following ", ff);
        !            15: }
        !            16: 
        !            17: Visible Procedure nothing(q, xp) txptr q; string xp; {
        !            18:        if (tx >= q) {
        !            19:                if (Char(tx-1) == ' ') tx--;
        !            20:                parerr("nothing instead of expected ", xp);
        !            21:        }
        !            22: }
        !            23: 
        !            24: Visible bool ateol() {
        !            25:        Skipsp(tx);
        !            26:        if (Ceol(tx)) {
        !            27:                To_eol(tx);
        !            28:                return Yes;
        !            29:        }
        !            30:        return No;
        !            31: }
        !            32: 
        !            33: #define Where_inside(r, t) \
        !            34:        register txptr ttx= tx; char lc= '+', q; \
        !            35:        register intlet parcnt= 0; register bool outs= Yes; bool kw= No; \
        !            36:        while (r) \
        !            37:        if (outs) { \
        !            38:                if (parcnt == 0 && (t))
        !            39: #define Otherwise \
        !            40:                if (Char(ttx) == '(' || Char(ttx) == '[' || Char(ttx) == '{') \
        !            41:                        parcnt++; \
        !            42:                else if (Char(ttx) == ')' || Char(ttx) == ']' || Char(ttx) == '}') { \
        !            43:                        if (parcnt > 0) parcnt--; \
        !            44:                } else if ((Char(ttx) == '\'' || Char(ttx) == '"') && !Keytagmark(lc)) { \
        !            45:                        outs= No; q= Char(ttx); \
        !            46:                } \
        !            47:                lc= Char(ttx++); kw= kw ? Keymark(lc) : Cap(lc); \
        !            48:        } else { \
        !            49:                if (Char(ttx) == q) { \
        !            50:                        outs= Yes; kw= No; lc= '+'; \
        !            51:                } else if (!outs && Char(ttx) == '`') { \
        !            52:                        txptr tx0= tx, yx, zx; \
        !            53:                        tx= ttx+1; \
        !            54:                        req("`", lcol(), &yx, &zx); \
        !            55:                        ttx= yx; tx= tx0; \
        !            56:                } \
        !            57:                ttx++; \
        !            58:        }
        !            59: 
        !            60: Visible Procedure findceol() {
        !            61:        Where_inside (!Eol(ttx), Char(ttx) == '\\') {
        !            62:                ceol= ttx;
        !            63:                return;
        !            64:        } Otherwise ceol= ttx;
        !            65: }
        !            66: 
        !            67: Visible bool atkw(ss) register string ss; {
        !            68:        register txptr tp= tx;
        !            69:        while (*ss) if (*ss++ != Char(tp++)) return No;
        !            70:        if (Keymark(Char(tp))) return No;
        !            71:        tx= tp;
        !            72:        return Yes;
        !            73: }
        !            74: 
        !            75: Visible Procedure need(ss) string ss; {
        !            76:        register string sp= ss;
        !            77:        Skipsp(tx);
        !            78:        while (*sp) if (*sp++ != Char(tx++))
        !            79:                pprerr("according to the syntax I expected ", ss);
        !            80: }
        !            81: 
        !            82: Visible Procedure thought(c) register char c; {
        !            83:        Skipsp(tx);
        !            84:        if (Char(tx++) != c) syserr("I'm confused; can't trust me own eyes");
        !            85: }
        !            86: 
        !            87: Visible Procedure reqkw(ss, ptx, qtx) string ss; txptr *ptx, *qtx; {
        !            88:        Where_inside (!Eol(ttx), Char(ttx) == *ss && !kw) {
        !            89:                string sp= ss+1;
        !            90:                *qtx= (*ptx= ttx)+1;
        !            91:                while (*sp) if (*sp++ != Char((*qtx)++)) goto isnt;
        !            92:                if (Keymark(Char(*qtx))) goto isnt;
        !            93:                return;
        !            94:        }
        !            95: isnt:  Otherwise parerr("cannot find expected ", ss);
        !            96: }
        !            97: 
        !            98: Visible Procedure req(ss, utx, ptx, qtx) string ss; txptr utx, *ptx, *qtx; {
        !            99:        Where_inside (ttx < utx && !Eol(ttx), Char(ttx) == *ss) {
        !           100:                string sp= ss+1;
        !           101:                *qtx= (*ptx= ttx)+1;
        !           102:                while (*sp && *qtx < utx) if (*sp++ != Char((*qtx)++)) goto isnt;
        !           103:                return;
        !           104:        }
        !           105: isnt:  Otherwise parerr("cannot find expected ", ss);
        !           106: }
        !           107: 
        !           108: Visible bool find(ss, utx, ptx, qtx) string ss; txptr utx, *ptx, *qtx; {
        !           109:        Where_inside (ttx < utx, Char(ttx) == *ss && !(kw && Cap(*ss))) {
        !           110:                string sp= ss+1;
        !           111:                *qtx= (*ptx= ttx)+1;
        !           112:                while (*sp && *qtx < utx) if (*sp++ != Char((*qtx)++)) goto isnt;
        !           113:                if (Cap(*ss) && Keymark(Char(*qtx))) goto isnt;
        !           114:                return Yes;
        !           115:        }
        !           116: isnt:  Otherwise return No;
        !           117: }
        !           118: 
        !           119: Visible intlet count(ss, utx) string ss; txptr utx; {
        !           120:        intlet cnt= 0;
        !           121:        Where_inside (ttx < utx, Char(ttx) == *ss) {
        !           122:                string sp= ss+1; txptr tp= ttx+1;
        !           123:                while (*sp && tp < utx) if (*sp++ != Char(tp++)) goto isnt;
        !           124:                cnt++;
        !           125:        }
        !           126: isnt:  Otherwise return cnt;
        !           127: }
        !           128: 
        !           129: #define TAGBUFSIZE 100
        !           130: char tagbuf[TAGBUFSIZE];
        !           131: txptr tagbufend= &tagbuf[TAGBUFSIZE];
        !           132: 
        !           133: Visible value tag() {
        !           134:        txptr tp= tagbuf; value res= Vnil;
        !           135:        Skipsp(tx);
        !           136:        if (!Letter(Char(tx))) return Vnil;
        !           137:        while (Tagmark(Char(tx))) {
        !           138:                *tp++= Char(tx++);
        !           139:                if (tp+1 >= tagbufend) {
        !           140:                        *tp= '\0';
        !           141:                        concat_to(&res, tagbuf);
        !           142:                        tp= tagbuf;
        !           143:                }
        !           144:        }
        !           145:        *tp= '\0';
        !           146:        concat_to(&res, tagbuf);
        !           147:        return(res);
        !           148: }
        !           149: 
        !           150: Visible value findkw(u, f, t) txptr u, *f, *t; {
        !           151:        txptr sp= tx, kp= tagbuf; value word= Vnil;
        !           152:        while (sp < u && !Cap(Char(sp))) sp++;
        !           153:        *f= sp;
        !           154:        while (sp < u && Keymark(Char(sp))) {
        !           155:                *kp++= Char(sp++);
        !           156:                if (kp+1 >= tagbufend) {
        !           157:                        *kp= '\0';
        !           158:                        concat_to(&word, tagbuf);
        !           159:                        kp= tagbuf;
        !           160:                }
        !           161:        }
        !           162:        *kp= '\0';
        !           163:        concat_to(&word, tagbuf);
        !           164:        *t= sp; /* if no keyword is found, f and t are set to u */
        !           165:        return(word);
        !           166: }
        !           167: 
        !           168: Visible value keyword(u) txptr u; {
        !           169:        txptr f;
        !           170:        Skipsp(tx);
        !           171:        if (!Cap(Char(tx))) parerr("no keyword where expected", "");
        !           172:        return findkw(u, &f, &tx);
        !           173: }
        !           174: 
        !           175: /* Stream handling */
        !           176: /* Txbuf holds streams of incoming characters from a file or the keyboard */
        !           177: /* The current stream is marked by txstart and txend,                    */
        !           178: /* with tx pointing somewhere in the middle                              */
        !           179: /* The main stream is for immediate commands, but new ones are created   */
        !           180: /* for reading units, and for the read command (when this is implemented) */
        !           181: 
        !           182: #define TXBUFSIZE (1<<13)
        !           183: char txbuf[TXBUFSIZE];
        !           184: txptr txbufstart= &txbuf[1], txstart, txend, txbufend= &txbuf[TXBUFSIZE];
        !           185: 
        !           186: intlet alino;
        !           187: 
        !           188: #define Interactive (interactive && sv_ifile == ifile)
        !           189: 
        !           190: Visible txptr fcol() { /* the first position of the current line */
        !           191:        txptr ax= tx;
        !           192:        while (!Eol(ax-1) && Char(ax-1) != Eotc) ax--;
        !           193:        return(ax);
        !           194: }
        !           195: 
        !           196: Visible txptr lcol() { /* the position beyond the last character of the line */
        !           197:        txptr ax= tx;
        !           198:        while (!Eol(ax)) ax++;
        !           199:        return(ax);
        !           200: }
        !           201: 
        !           202: Visible Procedure getline() {
        !           203:        intlet k; bool got;
        !           204:        if (Eof0) {
        !           205:                *txend++= Eouc; *txend= Eotc;
        !           206:                Eof= Yes;
        !           207:                return;
        !           208:        }
        !           209:        alino++;
        !           210:        got= No;
        !           211:        while (!got) {
        !           212:                if (Interactive) {
        !           213:                        if (outeractive) {
        !           214:                                line();
        !           215:                                at_nwl= No;
        !           216:                        }
        !           217:                        fprintf(stderr, cmd_prompt);
        !           218:                }
        !           219:                got= Yes;
        !           220:                while ((k= getc(ifile)) != EOF && k != '\n') {
        !           221:                        *txend++= k;
        !           222:                        if (txend > txbufend-5) syserr("text buffer overflow");
        !           223:                }
        !           224:                if (k == EOF && Interactive) {
        !           225:                        if (filtered) bye(0); /* Editor has died */
        !           226:                        fprintf(stderr, "\r*** use QUIT to end session\n");
        !           227:                        CLEAR_EOF;
        !           228:                        if (outeractive) at_nwl= Yes;
        !           229:                        got= No;
        !           230:                }
        !           231:        }
        !           232:        if (Interactive && outeractive && k == '\n') at_nwl= Yes;
        !           233:        *txend++= '\n'; *txend= Eotc;
        !           234:        Eof0= k == EOF;
        !           235: }
        !           236: 
        !           237: Visible intlet ilev(new) bool new; {
        !           238:        register intlet i;
        !           239:        lino++;
        !           240:        if (Char(tx) == Eouc) {
        !           241:                ++tx; /* veli() */
        !           242:                if(!new)debug("ilev saw Eouc and returns since new == No");
        !           243:                if (!new) return cur_ilev= 0;
        !           244:                debug("ilev saw Eouc but proceeds since new == Yes");
        !           245:        } else if (Char(tx++) != '\n')
        !           246:                syserr("ilev called when not at end of line");
        !           247:        if(Char(tx-1)!=Eouc)debug("ilev saw no Eouc");
        !           248:        if (Char(tx) == Eotc) getline();
        !           249:        i= 0;
        !           250:        while (Char(tx) == ' ' || Char(tx) == '\t') {
        !           251:                if (Char(tx) == ' ') i++;
        !           252:                else i= (i/4+1)*4;
        !           253:                tx++;
        !           254:        }
        !           255:        if (Char(tx) == '\n') return cur_ilev= 0;
        !           256:        if (i%4 == 2)
        !           257:                parerr("cannot make out indentation; use tab to indent", "");
        !           258:        return cur_ilev= (i+1)/4; /* small deviation accepted */
        !           259: }
        !           260: 
        !           261: Visible Procedure veli() {
        !           262:        /* resets tx after look-ahead call of ilev */
        !           263:        debug("calling veli");
        !           264:        while (Char(--tx) != '\n' && Char(tx) != Eouc);
        !           265:        lino--;
        !           266:        debug("leaving veli");
        !           267: }
        !           268: 
        !           269: Visible Procedure inistreams() {
        !           270:        txstart= txbufstart;
        !           271:        start_stream();
        !           272: }
        !           273: 
        !           274: Visible Procedure re_streams() {
        !           275:        if (Char(tx+1) == Eotc) inistreams();
        !           276: }
        !           277: 
        !           278: Visible Procedure open_stream() {
        !           279:        txstart= txend+2;
        !           280:        start_stream();
        !           281: }
        !           282: 
        !           283: Hidden Procedure start_stream() {
        !           284:        *(txend= txstart)= Eotc;
        !           285:        tx= txend-1;
        !           286:        *tx= Eouc;
        !           287: }
        !           288: 
        !           289: Visible Procedure close_stream(otx, otxstart) txptr otx, otxstart; {
        !           290:        txend= txstart-2;
        !           291:        tx= otx;
        !           292:        txstart= otxstart;
        !           293: }

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