Annotation of 43BSDTahoe/new/B/src/bsmall/b2syn.c, revision 1.1.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: }

unix.superglobalmegacorp.com

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