# 2.11BSD#431 - /usr/src/new/PORT/B/src/bsmall/b2cmd.c

##### Functions

    alt_suite         X
    chckvtc           X
    check             X
    comm_suite        X
    command           X
    con_com           X
    expr_s            X
    read_line         X
    secret_com        X
    sim_com           X
    term_com          X

##### Variables

    Hidden            X
    Procedure         X
    comcnt            X
    rdbuf             X
    rdbufend          X

##### Macros

    Nex               X
    Reqcol            X
    Resetx            X
    USE_QUIT          X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
       2: /* $Header: b2cmd.c,v 1.1 84/06/28 00:49:04 timo Exp $ */
       3:
       4: /* B commands */
       5: #include "b.h"
       6: #include "b0con.h"
       7: #include "b1obj.h"
       8: #include "b2env.h"
       9: #include "b2scr.h"
      10: #include "b2err.h"
      11: #include "b2key.h"
      12: #include "b2syn.h"
      13: #include "b2sem.h"
      14: #include "b2typ.h"
      15:
      16: #define Nex if (!xeq) {tx= ceol; return Yes;}
      17:
      18: char rdbuf[RDBUFSIZE];
      19: txptr rdbufend= &rdbuf[RDBUFSIZE];
      20:
      21: #define USE_QUIT "\r*** use QUIT or interrupt to abort READ command\n"
      22:
      23: Hidden Procedure read_line(l, t, eg) loc l; btype t; bool eg; {
      24:     context c; txptr tx0= tx, rp; intlet k; value r; btype rt;
      25:     envtab svprmnvtab= Vnil; bool must_sv= eg, got;
      26:     sv_context(&c);
      27:     if (active_reads >= MAX_NMB_ACT_READS)
      28:         error("too many READs simultaneously active");
      29:     if (setjmp(reading[active_reads++]) != 0) /* long jump occurred */
      30:         set_context(&c);
      31:     if (cntxt != In_read) sv_context(&read_context);
      32:     if (must_sv) svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
      33:     /* save scratch-pad copy because of following setprmnv() */
      34:     if (eg) setprmnv(); must_sv= No;
      35:     cntxt= In_read;
      36:     got= No;
      37:     while (!got) {
      38:         tx= rp= rdbuf;
      39:         if (read_interactive) {
      40:             fprintf(stderr, eg ? eg_prompt : raw_prompt);
      41:         }
      42:         got= Yes;
      43:         while ((k= getchar()) != EOF && k != '\n') {
      44:             *rp++= k;
      45:             if (rp > rdbufend-1) syserr("read buffer overflow");
      46:         }
      47:         if (k == EOF) {
      48:             if (read_interactive) {
      49:                 fprintf(stderr, USE_QUIT);
      50:                 CLEAR_EOF;
      51:                 if (outeractive) at_nwl= Yes;
      52:                 got= No;
      53:             } else error("End of file encountered during READ command");
      54:         }
      55:     }
      56:     if (read_interactive && outeractive && k == '\n') at_nwl= Yes;
      57:     *rp= '\n';
      58:     Skipsp(tx);
      59:     if (atkw(QUIT)) int_signal(Yes);
      60:     if (eg) {
      61:         r= expr(rp); rt= valtype(r);
      62:         if (svprmnvtab != Vnil) {
      63:             prmnvtab= prmnv->tab;
      64:             prmnv->tab= svprmnvtab;
      65:         }
      66:         must_sv= Yes;
      67:         set_context(&c);
      68:         must_agree(t, rt,
      69:             "type of expression does not agree with that of EG sample");
      70:         release(rt);
      71:     } else {
      72:         *rp= '\0';
      73:         r= mk_text(rdbuf);
      74:         set_context(&c);
      75:     }
      76:     put(r, l);
      77:     active_reads--;
      78:     release(r);
      79:     tx= tx0;
      80: }
      81:
      82: Hidden Procedure check(o) outcome o; {
      83:     if (o == Fail) checkerr();
      84: }
      85:
      86: Hidden bool sim_com() {
      87:     txptr ftx, ttx;
      88:     switch (Char(tx)) {
      89: case 'C': if (atkw(CHECK)) {
      90:         env e0= curnv; outcome o;
      91:         Nex;
      92:         o= test(ceol);
      93:         if (xeq) {
      94:             check(o);
      95:             restore_env(e0);
      96:         }
      97:         return Yes;
      98:     } else if (atkw(CHOOSE)) {
      99:         loc l; value v;
     100:         reqkw(FROM_choose, &ftx, &ttx);
     101:         Nex;
     102:         l= targ(ftx);
     103:         tx= ttx; v= expr(ceol);
     104:         if (xeq) choose(l, v);
     105:         release(v); release(l);
     106:         return Yes;
     107:       }
     108:       return No;
     109: case 'D': if (atkw(DELETE)) {
     110:         loc l;
     111:         Nex;
     112:         l= targ(ceol);
     113:         if (xeq) l_delete(l);
     114:         release(l);
     115:         return Yes;
     116:     } else if (atkw(DRAW)) {
     117:         loc l;
     118:         Nex;
     119:         l= targ(ceol);
     120:         if (xeq) draw(l);
     121:         release(l);
     122:         return Yes;
     123:       }
     124:       return No;
     125: case 'E': if (atkw(ELSE)) {
     126:            pprerr("ELSE only allowed as alternative test after SELECT", "");
     127:       }
     128:       return No;
     129: case 'I': if (atkw(INSERT)) {
     130:         value v; loc l;
     131:         reqkw(IN_insert, &ftx, &ttx);
     132:         Nex;
     133:         v= expr(ftx);
     134:         tx= ttx; l= targ(ceol);
     135:         if (xeq) l_insert(v, l);
     136:         release(v); release(l);
     137:         return Yes;
     138:       }
     139:       return No;
     140: case 'P': if (atkw(PUT)) {
     141:         value v; loc l;
     142:         reqkw(IN_put, &ftx, &ttx);
     143:         Nex;
     144:         v= expr(ftx);
     145:         tx= ttx; l= targ(ceol);
     146:         if (xeq) put(v, l);
     147:         release(v); release(l);
     148:         return Yes;
     149:       }
     150:       return No;
     151: case 'R': if (atkw(READ)) {
     152:         value v; loc l; btype vt, lt; bool eg= Yes;
     153:         if (find(RAW, ceol, &ftx, &ttx)) {
     154:             eg= No;
     155:             vt= mk_text("");
     156:         } else reqkw(EG, &ftx, &ttx);
     157:         Nex;
     158:         l= targ(ftx); lt= loctype(l);
     159:         tx= ttx;
     160:         if (eg) {
     161:             v= expr(ceol);
     162:             vt= valtype(v); release(v);
     163:         }
     164:         must_agree(vt, lt,
     165:             eg ? "this sample could not lawfully be put in the target"
     166:                : "in READ x RAW, x must be a simple textual target");
     167:         release(lt);
     168:         if (xeq) read_line(l, vt, eg);
     169:         release(l); release(vt);
     170:         return Yes;
     171:     } else if (atkw(REMOVE)) {
     172:         value v; loc l;
     173:         reqkw(FROM_remove, &ftx, &ttx);
     174:         Nex;
     175:         v= expr(ftx);
     176:         tx= ttx; l= targ(ceol);
     177:         if (xeq) l_remove(v, l);
     178:         release(v); release(l);
     179:         return Yes;
     180:       }
     181:       return No;
     182: case 'S': if (atkw(SET_RANDOM)) {
     183:         value v;
     184:         Nex;
     185:         v= expr(ceol);
     186:         if (xeq) set_random(v);
     187:         release(v);
     188:         return Yes;
     189:       } else if (atkw(SHARE)) pprerr(
     190:       "SHARE only allowed following HOW'TO-, YIELD- or TEST-heading", "");
     191:       return No;
     192: case 'W': if (atkw(WRITE)) {
     193:         txptr tx0; value v; intlet nwlc;
     194:         Nex;
     195:         Skipsp(tx);
     196:         while (Char(tx) == '/' && (Char(tx+1) == '/')) {
     197:             if (xeq) newline();
     198:             tx++;
     199:         }
     200:         tx0= tx;
     201:     loop:   if (Char(tx++) != '/') {tx= tx0; goto postnl;}
     202:         if (Char(tx++) == '*') goto loop;
     203:         if (xeq) newline();
     204:         tx= tx0+1;
     205:     postnl: ftx= ceol;
     206:         while (Space(Char(ftx-1))) ftx--;
     207:         nwlc= 0;
     208:         while (ftx > tx && Char(ftx-1) == '/') {
     209:             nwlc++;
     210:             ftx--;
     211:         }
     212:         if (ftx > tx) {
     213:             v= expr(ftx);
     214:             if (xeq) writ(v);
     215:             release(v);
     216:         }
     217:         while (nwlc-- > 0) {
     218:             if (xeq) newline();
     219:         }
     220:         return Yes;
     221:       }
     222:       return No;
     223: default:  return No;
     224:     }
     225: }
     226:
     227: #define Reqcol {req(":", ceol, &utx, &vtx); \
     228:         if (!xeq) {tx= vtx; comm_suite(); return Yes;}}
     229: #define Resetx(tx0) {tx= (tx0); lino= lino0; cur_ilev= cil;}
     230:
     231: Hidden bool con_com() {
     232:     intlet lino0= lino, cil= cur_ilev;
     233:     txptr ftx, ttx, utx, vtx;
     234:     switch (Char(tx)) {
     235: case 'I': if (atkw(IF)) {
     236:         env e0= curnv; bool xeq0= xeq;
     237:         outcome o;
     238:         Reqcol;
     239:         o= test(utx);
     240:         xeq= o == Succ;
     241:         tx= vtx; comm_suite();
     242:         xeq= xeq0; restore_env(e0);
     243:         return Yes;
     244:       }
     245:       return No;
     246: case 'S': if (atkw(SELECT)) {
     247:         need(":");
     248:         upto(ceol, "SELECT:");
     249:         alt_suite();
     250:         return Yes;
     251:       }
     252:       return No;
     253: case 'W': if (atkw(WHILE)) {
     254:         env e0= curnv; bool xeq0= xeq; txptr tx0= tx;
     255:         outcome o;
     256:         Reqcol;
     257:     loop:   o= test(utx);
     258:         if (xeq0) xeq= o == Succ;
     259:         tx= vtx; comm_suite();
     260:         xeq= xeq0; restore_env(e0);
     261:         if (xeq && o == Succ && !terminated) {
     262:             Resetx(tx0); goto loop;
     263:         }
     264:         return Yes;
     265:       }
     266:       return No;
     267: case 'F': if (atkw(FOR)) {
     268:         env e0= curnv; bool xeq0= xeq; loc l; value v, w;
     269:         Reqcol;
     270:         if (find(PARSING, utx, &ftx, &ttx)) {
     271:             tx= ttx; pprerr("PARSING not allowed in FOR ...", "");
     272:         }
     273:         reqkw(IN_for, &ftx, &ttx);
     274:         if (ttx > ceol) {
     275:             tx= ceol;
     276:             parerr("IN after colon", "");
     277:         }
     278:         l= targ(ftx);
     279:         if (!Is_simploc(l) && !Is_compound(l)) /*to bloc.c?*/
     280:             pprerr("inappropriate identifier after FOR", "");
     281:         bind(l);
     282:         tx= ttx; v= expr(utx);
     283:         {value k, k1, len= xeq ? size(v) : copy(one);
     284:             if (compare(len, zero) == 0) {
     285:                 xeq= No; release(len); len= copy(one);
     286:             }
     287:             k= copy(one);
     288:             while (!terminated && compare(k, len) <= 0) {
     289:                 Resetx(utx);
     290:                 if (xeq) {
     291:                     w= th_of(k, v);
     292:                     put(w, l);
     293:                     release(w);
     294:                 }
     295:                 k= sum(k1= k, one); release(k1);
     296:                 tx= vtx; comm_suite();
     297:             }
     298:             release(k); release(len);
     299:         }
     300:         xeq= xeq0; restore_env(e0);
     301:         release(v); release(l);
     302:         return Yes;
     303:       }
     304:       return No;
     305: default:  return No;
     306:     }
     307: }
     308:
     309: Hidden bool term_com() {
     310:     switch (Char(tx)) {
     311: case 'F': if (atkw(FAIL)) {
     312:         upto(ceol, "FAIL");
     313:         if (xeq) {
     314:             chckvtc(Rep);
     315:             resout= Fail;
     316:             terminated= Yes;
     317:         } else tx= ceol;
     318:         return Yes;
     319:       }
     320:       return No;
     321: case 'Q': if (atkw(QUIT)) {
     322:         upto(ceol, "QUIT");
     323:         if (xeq) {
     324:             if (cur_ilev == 0) bye(0);
     325:             chckvtc(Voi);
     326:             terminated= Yes;
     327:         }
     328:         return Yes;
     329:       }
     330:       return No;
     331: case 'R': if (atkw(RETURN)) {
     332:         if (xeq) {
     333:             chckvtc(Ret);
     334:             resval= expr(ceol);
     335:             terminated= Yes;
     336:         } else tx= ceol;
     337:         return Yes;
     338:       } else if (atkw(REPORT)) {
     339:         if (xeq) {
     340:             chckvtc(Rep);
     341:             resout= test(ceol);
     342:             terminated= Yes;
     343:         } else tx= ceol;
     344:         return Yes;
     345:       }
     346:       return No;
     347: case 'S': if (atkw(SUCCEED)) {
     348:         upto(ceol, "SUCCEED");
     349:         if (xeq) {
     350:             chckvtc(Rep);
     351:             resout= Succ;
     352:             terminated= Yes;
     353:         } else tx= ceol;
     354:         return Yes;
     355:       }
     356:       return No;
     357: default:  return No;
     358:     }
     359: }
     360:
     361: Hidden bool secret_com() {
     362:     switch (Char(tx)) {
     363: case 'D': if (atkw("DEBUG")) {
     364:         Nex;
     365:         bugs= Yes;
     366:         return Yes;
     367:       }
     368:       return No;
     369: case 'G': if (atkw("GR")) {
     370:         Nex;
     371:         prgr();
     372:         return Yes;
     373:       }
     374:       return No;
     375: case 'N': if (atkw("NO'DEBUG")) {
     376:         Nex;
     377:         bugs= No;
     378:         return Yes;
     379:       } else if (atkw("NO'TRACE")) {
     380:         Nex;
     381:         tracing= No;
     382:         return Yes;
     383:       }
     384:       return No;
     385: case 'T': if (atkw("TRACE")) {
     386:         Nex;
     387:         tracing= Yes;
     388:         return Yes;
     389:       }
     390:       return No;
     391: default:  return No;
     392:     }
     393: }
     394:
     395: Hidden Procedure chckvtc(re) literal re; {
     396:     if (cntxt != In_unit || resexp == Voi) {
     397:         if (re == Ret)
     398:             pprerr("RETURN e only allowed inside YIELD-unit or\n",
     399:                    "    expression-refinement");
     400:         else if (re == Rep)
     401:             pprerr("REPORT t only allowed inside TEST-unit",
     402:                    " or test-refinement");
     403:     }
     404:     if (re != resexp) {
     405:         if (resexp == Ret)
     406:             pprerr(
     407:     "RETURN e must terminate YIELD-unit or expression-refinement", "");
     408:         if (resexp == Rep)
     409:             pprerr(
     410:     "REPORT t must terminate TEST-unit or test-refinement", "");
     411:     }
     412: }
     413:
     414: Hidden bool expr_s() {
     415:     char c;
     416:     Skipsp(tx);
     417:     if (tx >= ceol) return No;
     418:     c= Char(tx);
     419:     return Letter(c) || Montormark(c) || Dig(c) || c == '.' || c == 'E' ||
     420:         c == '(' || c == '{' || c == '\'' || c == '"';
     421: }
     422:
     423: intlet comcnt= 0;
     424:
     425: Visible Procedure command() {
     426:     if (++comcnt > 10000) {
     427:         putprmnv();
     428:         comcnt= 1;
     429:     }
     430:     if (Char(tx) == Eotc) getline();
     431: debug("analyzing command");
     432:     if (tracing) trace();
     433:     if (Ceol(tx));
     434:     else if (sim_com() || con_com() ||
     435:         unit() || term_com() || ref_com() || udc() ||
     436:         secret_com()) skipping= No;
     437:     else if (Char(tx) == ':' || Char(tx) == '=' || Char(tx) == '!') {
     438:         if (!interactive) parerr("special commands only interactively", "");
     439:         if (!(cntxt == In_command && cur_ilev == 0)) parerr(
     440:             "special commands only on outermost level (no indentation)", "");
     441:         special();
     442:     } else if (cntxt == In_command && cur_ilev == 0 && expr_s()) {
     443:         value w= expr(ceol);
     444:         wri(w, Yes, No, No);
     445:         release(w);
     446:     } else {txptr tx0= tx; value uc= keyword(ceol);
     447:         tx= tx0; parerr("you have not told me HOW'TO ", strval(uc));
     448:     }
     449:     To_eol(tx);
     450: debug("command treated");
     451: }
     452:
     453: Visible Procedure comm_suite() {
     454:     intlet cil= cur_ilev;
     455:     if (ateol()) {
     456:         txptr tx0= tx; bool xeq0= xeq;
     457:         if (Char(tx+1) == Eotc) xeq= No;
     458:         while (ilev(No) > cil) {
     459:             findceol();
     460:             command();
     461:             if (terminated) return;
     462:             if (cur_ilev <= cil) goto brk1;
     463:         }
     464:         veli();
     465:     brk1:   if (xeq0 && !xeq) {
     466:             tx= tx0; xeq= Yes;
     467:             cur_ilev= cil;
     468:             while (ilev(No) > cil) {
     469:                 findceol();
     470:                 command();
     471:                 if (terminated) return;
     472:                 if (cur_ilev <= cil) goto brk2;
     473:             }
     474:             veli();
     475:         brk2:   ;
     476:         }
     477:     } else command();
     478: }
     479:
     480: Hidden Procedure alt_suite() {
     481:     intlet cil= cur_ilev; env e0= curnv; txptr utx, vtx;
     482:     bool xeq0= xeq, succ= !xeq, Else= No;
     483:     if (!ateol()) syserr("alt_suite not at end of line");
     484:     while (ilev(No) > cil) {
     485:         findceol();
     486:         if (Else)
     487:         parerr("after ELSE: ... no more alternatives are allowed", "");
     488:         req(":", ceol, &utx, &vtx);
     489:         if (atkw(ELSE)) {
     490:             succ= Else= Yes;
     491:             upto(utx, "ELSE");
     492:             tx= vtx; comm_suite();
     493:             if (terminated) return;
     494:         } else {
     495:             if (xeq) succ= test(utx) == Succ;
     496:             xeq= xeq && succ;
     497:             tx= vtx; comm_suite();
     498:             if (terminated) return;
     499:             xeq= !succ;
     500:         }
     501:         if (cur_ilev <= cil) goto brk;
     502:     }
     503:     veli();
     504: brk:    if (!succ) error("none of the alternative tests of SELECT succeeds");
     505:     xeq= xeq0; if (xeq) restore_env(e0);
     506: }

#### Defined functions

alt_suite defined in line 480; used 1 times

- in line 249

chckvtc defined in line 395; used 5 times

- in line 314, 325, 333, 340, 350

check defined in line 82; used 1 times

- in line 94

comm_suite defined in line 453; used 10 times

- in line 228, 241, 259, 296, 492-497(2)
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 254, 354, 440, 524

command defined in line 425; used 5 times

- in line 460, 470, 477
- in /usr/src/new/PORT/B/src/bsmall/b2mai.c line 132
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 442

con_com defined in line 231; used 1 times

- in line 434

expr_s defined in line 414; used 1 times

- in line 442

read_line defined in line 23; used 1 times

- in line 168

secret_com defined in line 361; used 1 times

- in line 436

sim_com defined in line 86; used 1 times

- in line 434

term_com defined in line 309; used 1 times

- in line 435

#### Defined variables

Hidden defined in line 395; never used
Procedure defined in line 395; never used
comcnt defined in line 423; used 2 times

- in line 426-428(2)

rdbuf defined in line 18; used 3 times

- in line 19, 38, 73

rdbufend defined in line 19; used 1 times

- in line 45

#### Defined macros

Nex defined in line 16; used 15 times

- in line 91, 101, 111, 118, 132, 143, 157, 174, 184, 194, 364, 370, 376-380(2), 386

Reqcol defined in line 227; used 3 times

- in line 238, 256, 269

Resetx defined in line 229; used 2 times

- in line 262, 289

USE_QUIT defined in line 21; used 1 times

- in line 49

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 2279 |