4.3BSD - /usr/src/new/B/src/bsmall/b2syn.c

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

Defined functions

Defined variables

Defined macros