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

##### Functions

    basexpr           X
    clocondis         X
    concat_to         X
    constant          X
    conversion        X
    expr              X
    inittors          X
    obasexpr          X
    pop_stack         X
    popnd             X
    primary           X
    pushdyator        X
    pushmontor        X
    pushnd            X
    statabsel         X
    text_dis          X
    tl_dis            X
    trimbc            X
    trimi             X

##### Variables

    txdbuf            X
    txdbufend         X

##### Macros

    Bot               X
    Fpush             X
    Ipush             X
    Pbot              X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
       2: /* $Header: b2exp.c,v 1.1 84/06/28 00:49:08 timo Exp $ */
       3:
       4: /* B expression evaluation */
       5: #include "b.h"
       6: #include "b0con.h"
       7: #include "b1obj.h"
       8: #include "b1mem.h" /* for ptr */
       9: #include "b2env.h"
      10: #include "b2syn.h"
      11: #include "b2sem.h"
      12: #include "b2sou.h"
      13:
      14: /*************************************************************/
      15: /*                                                           */
      16: /* The operand and operator stacks are modelled as compounds */
      17: /* whose first field is the top and whose second field is    */
      18: /* the remainder of the stack (i.e., linked lists).          */
      19: /* A cleaner and more efficient implementation of            */
      20: /* these heavily used stacks would be in order.              */
      21: /*                                                           */
      22: /*************************************************************/
      23:
      24: /* nd = operand, tor = operator (function) */
      25:
      26: value ndstack, torstack;
      27: #define Bot Vnil
      28: fun Bra, Ket;
      29:
      30: Visible Procedure inittors() {
      31:     ndstack= torstack= Vnil;
      32:     Bra= mk_fun(-1, -1, Mon, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy);
      33:     Ket= mk_fun( 0,  0, Dya, (literal)Dummy, (txptr)Dummy, (txptr)Dummy, (value)Dummy, (bool)Dummy);
      34: }
      35:
      36: Hidden Procedure pop_stack(stack) value *stack; {
      37:     value oldstack= *stack;
      38:     *stack= *field(*stack, 1);
      39:     put_in_field(Vnil, &oldstack, 0); put_in_field(Vnil, &oldstack, 1);
      40:     release(oldstack);
      41: }
      42:
      43: Hidden value popnd() {
      44:     value r;
      45:     if (ndstack == Vnil) syserr("operand stack underflow");
      46:     r= *field(ndstack, 0);
      47:     pop_stack(&ndstack);
      48:     return r;
      49: }
      50:
      51: Hidden Procedure pushnd(nd) value nd; {
      52:     value s= ndstack;
      53:     ndstack= mk_compound(2);
      54:     put_in_field(nd, &ndstack, 0); put_in_field(s, &ndstack, 1);
      55: }
      56:
      57: Hidden Procedure pushmontor(tor) value tor; {
      58:     value s= torstack;
      59:     torstack= mk_compound(2);
      60:     put_in_field(tor, &torstack, 0); put_in_field(s, &torstack, 1);
      61: }
      62:
      63: Hidden Procedure pushdyator(tor2) value tor2; {
      64:     value tor1; funprd *t1, *t2= Funprd(tor2);
      65:     intlet L1, H1, L2= t2->L, H2= t2->H;
      66:  prio:  if (torstack == Vnil) syserr("operator stack underflow");
      67:     tor1= *field(torstack, 0); t1= Funprd(tor1),
      68:     L1= t1->L; H1= t1->H;
      69:     if (L2 > H1)
      70:         if (tor2 == Ket) {
      71:             if (tor1 != Bra)
      72:                 syserr("local operator stack underflow");
      73:             pop_stack(&torstack);
      74:         }
      75:         else pushmontor(tor2);
      76:     else if (L1 >= H2) {
      77:         value nd1= Vnil, nd2= popnd();
      78:         if (t1->adic == Dya) nd1= popnd();
      79:         pushnd(formula(nd1, tor1, nd2));
      80:         if (xeq) {
      81:             release(nd2);
      82:             release(nd1);
      83:         }
      84:         pop_stack(&torstack);
      85:         goto prio;
      86:     } else pprerr("priorities? use ( and ) to resolve", "");
      87: }
      88:
      89: Forward value basexpr();
      90: Forward value text_dis();
      91: Forward value tl_dis();
      92:
      93: Hidden value statabsel(t, k) value t, k; {
      94:     /* temporary, while no static type check */
      95:     return mk_elt();
      96: }
      97:
      98: Visible value expr(q) txptr q; {
      99:     value c, v; txptr i, j; intlet len, k;
     100:     if ((len= 1+count(",", q)) == 1) return basexpr(q);
     101:     c= mk_compound(len);
     102:     k_Overfields {
     103:         if (Lastfield(k)) i= q;
     104:         else req(",", q, &i, &j);
     105:         v= basexpr(i);
     106:         put_in_field(v, &c, k);
     107:         if (!Lastfield(k)) tx= j;
     108:     }
     109:     return c;
     110: }
     111:
     112: Hidden value basexpr(q) txptr q; {
     113:     value v= obasexpr(q);
     114:     Skipsp(tx);
     115:     if (tx < q && Char(tx) == ',')
     116:         parerr("no commas allowed in this context", "");
     117:     upto(q, "expression");
     118:     return v;
     119: }
     120:
     121: Forward bool primary(), clocondis();
     122:
     123: #define Pbot {pushnd(Bot); pushmontor(Bra);}
     124: #define Ipush if (!pushing) {Pbot; pushing= Yes;}
     125: #define Fpush if (pushing) {                                    \
     126:               pushnd(v); pushdyator(Ket); v= popnd();   \
     127:               if (popnd() != Bot) syserr(               \
     128:                   xeq ? "formula evaluation awry" : \
     129:                       "formula parsing awry");  \
     130:           }
     131:
     132: Visible value obasexpr(q) txptr q; {
     133:     value v, t; bool pushing= No;
     134:  nxtnd: Skipsp(tx);
     135:     nothing(q, "expression");
     136:     t= tag();
     137:     if (primary(q, t, &v, Yes)) /* then t is released */;
     138:     else if (t != Vnil) {
     139:         value f;
     140:         if (is_monfun(t, &f)) {
     141:             release(t);
     142:             Ipush;
     143:             pushmontor(f);
     144:             goto nxtnd;
     145:         } else {
     146:             release(t);
     147:             error("target has not yet received a value");
     148:         }
     149:     } else if (Montormark(Char(tx))) {
     150:         Ipush;
     151:         pushmontor(montor());
     152:         goto nxtnd;
     153:     } else parerr("no expression where expected", "");
     154:     /* We are past an operand and look for an operator */
     155:     Skipsp(tx);
     156:     if (tx < q) {
     157:         txptr tx0= tx; bool lt, eq, gt;
     158:         if (Letter(Char(tx))) {
     159:             fun f;
     160:             t= tag();
     161:             if (is_dyafun(t, &f)) {
     162:                 release(t);
     163:                 Ipush;
     164:                 pushnd(v);
     165:                 pushdyator(f);
     166:                 goto nxtnd;
     167:             }
     168:             release(t);
     169:         } else if (relop(&lt, &eq, &gt));
     170:         else if (Dyatormark(Char(tx))) {
     171:             Ipush;
     172:             pushnd(v);
     173:             pushdyator(dyator());
     174:             goto nxtnd;
     175:         }
     176:         tx= tx0;
     177:     }
     178:     Fpush;
     179:     return v;
     180: }
     181:
     182: Hidden bool clocondis(q, p) txptr q; value *p; {
     183:     txptr i, j;
     184:     Skipsp(tx);
     185:     nothing(q, "expression");
     186:     if (Char(tx) == '(') {
     187:         tx++; req(")", q, &i, &j);
     188:         *p= expr(i); tx= j;
     189:         return Yes;
     190:     }
     191:     if (Dig(Char(tx)) || Char(tx) == '.' || Char(tx) == 'E' &&
     192:        (Dig(Char(tx+1)) || Char(tx+1)=='+' || Char(tx+1)=='-')) {
     193:         *p= constant(q);
     194:         return Yes;
     195:     }
     196:     if (Char(tx) == '\'' || Char(tx) == '"') {
     197:         *p= text_dis(q);
     198:         return Yes;
     199:     }
     200:     if (Char(tx) == '{') {
     201:         *p= tl_dis(q);
     202:         return Yes;
     203:     }
     204:     return No;
     205: }
     206:
     207: Hidden bool primary(q, t, p, tri) txptr q; value t, *p; bool tri; {
     208: /* If a tag has been seen, it is held in t.
     209:    Releasing t is a task of primary, but only if the call succeeds. */
     210:     fun f; value tt, relt= Vnil; value *aa= &t;
     211:     if (t != Vnil) /* tag */ {
     212:         if (xeq) {
     213:             tt= t;
     214:             aa= lookup(t);
     215:             if (aa == Pnil) {
     216:                 if (is_zerfun(t, &f)) {
     217:                     t= formula(Vnil, f, Vnil);
     218:                     aa= &t;
     219:                 } else return No;
     220:             } else if (Is_refinement(*aa)) {
     221:                 ref_et(*aa, Ret); t= resval; resval= Vnil;
     222:                 aa= &t;
     223:             } else if (Is_formal(*aa)) {
     224:                 t= eva_formal(*aa);
     225:                 aa= &t;
     226:             } else if (Is_shared(*aa)) {
     227:                 if (!in_env(prmnv->tab, t, &aa)) return No;
     228:                 if (Is_filed(*aa))
     229:                     if (!is_tloaded(t, &aa)) return No;
     230:                 t= Vnil;
     231:             } else if (Is_filed(*aa)) {
     232:                 if (!is_tloaded(t, &aa)) return No;
     233:                 t= Vnil;
     234:             } else t= Vnil;
     235:             release(tt);
     236:         }
     237:     } else if (clocondis(q, &t)) aa= &t;
     238:     else return No;
     239:     Skipsp(tx);
     240:     while (tx < q && Char(tx) == '[') {
     241:         txptr i, j; value s;
     242:         tx++; req("]", q, &i, &j);
     243:         s= expr(i); tx= j;
     244:         /* don't copy table for selection */
     245:         if (xeq) {
     246:             aa= adrassoc(*aa, s);
     247:             release(s);
     248:             relt= t;
     249:             if (aa == Pnil) error("key not in table");
     250:         } else {
     251:             t= statabsel(tt= t, s);
     252:             release(tt); release(s);
     253:         }
     254:         Skipsp(tx);
     255:     }
     256:     if (tri && tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
     257:         intlet B, C;
     258:         if (xeq && !Is_text(*aa))
     259:             parerr("in t@p or t|p, t is not a text", "");
     260:         trimbc(q, xeq ? length(*aa) : 0, &B, &C);
     261:         if (xeq) {
     262:             relt= t;
     263:             t= trim(*aa, B, C);
     264:             aa= &t;
     265:         }
     266:     }
     267:     *p= t == Vnil || relt != Vnil ? copy(*aa) : t;
     268:     release(relt);
     269:     return Yes;
     270: }
     271:
     272: Forward intlet trimi();
     273:
     274: Visible Procedure trimbc(q, len, B, C) txptr q; intlet len, *B, *C; {
     275:     char bc; intlet N;
     276:     *B= *C= 0;
     277:     while (tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
     278:         bc= Char(tx++);
     279:         N= trimi(q);
     280:         if (bc == '@') *B+= N-1;
     281:         else *C+= (len-*B-*C)-N;
     282:         if (*B < 0 || *C < 0 || *B+*C > len)
     283:             error("in t@p or t|p, p is out of bounds");
     284:         Skipsp(tx);
     285:     }
     286: }
     287:
     288: Hidden intlet trimi(q) txptr q; {
     289:     value v, t; bool pushing= No;
     290:  nxtnd: Skipsp(tx);
     291:     nothing(q, "expression");
     292:     t= tag();
     293:     if (primary(q, t, &v, No)); /* then t is released */
     294:     else if (t != Vnil) {
     295:         value f;
     296:         if (is_monfun(t, &f)) {
     297:             release(t);
     298:             Ipush;
     299:             pushmontor(f);
     300:             goto nxtnd;
     301:         } else {
     302:             release(t);
     303:             error("target has not yet received a value");
     304:         }
     305:     } else if (Montormark(Char(tx))) {
     306:         Ipush;
     307:         pushmontor(montor());
     308:         goto nxtnd;
     309:     } else parerr("no expression where expected", "");
     310:     Fpush;
     311:     {int ii; intlet i= 0;
     312:         if (xeq) {
     313:             ii= intval(v);
     314:             if (ii < 0) error("in t@p or t|p, p is negative");
     315:             if (ii > Maxintlet)
     316:                 error("in t@p or t|p, p is excessive");
     317:             i= ii;
     318:         }
     319:         release(v);
     320:         return i;
     321:     }
     322: }
     323:
     324: Visible value constant(q) txptr q; {
     325:     bool dig= No; txptr first= tx;
     326:     while (tx < q && Dig(Char(tx))) {
     327:         ++tx;
     328:         dig= Yes;
     329:     }
     330:     if (tx < q && Char(tx) == '.') {
     331:         tx++;
     332:         while (tx < q && Dig(Char(tx))) {
     333:             dig= Yes;
     334:             ++tx;
     335:         }
     336:         if (!dig) pprerr("point without digits", "");
     337:     }
     338:     if (tx < q && Char(tx) == 'E') {
     339:         tx++;
     340:         if (!(Dig(Char(tx))) && Keymark(Char(tx))) {
     341:             tx--;
     342:             goto done;
     343:         }
     344:         if (tx < q && (Char(tx) == '+' || Char(tx) == '-')) ++tx;
     345:         dig= No;
     346:         while (tx < q && Dig(Char(tx))) {
     347:             dig= Yes;
     348:             ++tx;
     349:         }
     350:         if (!dig) parerr("E not followed by exponent", "");
     351:     }
     352:  done:  return numconst(first, tx);
     353: }
     354:
     355: char txdbuf[TXDBUFSIZE];
     356: txptr txdbufend= &txdbuf[TXDBUFSIZE];
     357:
     358: Visible Procedure concat_to(v, s) value* v; string s; { /*TEMPORARY*/
     359:     value v1, v2;
     360:     if (*v == Vnil) *v= mk_text(s);
     361:     else {
     362:         *v= concat(v1= *v, v2= mk_text(s));
     363:         release(v1); release(v2);
     364:     }
     365: }
     366:
     367: Hidden value text_dis(q) txptr q; {
     368:     char aq[2]; txptr tp= txdbuf; value t= Vnil, t1, t2;
     369:     aq[1]= '\0'; *aq= Char(tx++);
     370:  fbuf:  while (tx < q && Char(tx) != *aq) {
     371:         if (Char(tx) == '`') {
     372:             if (Char(tx+1) == '`') tx++;
     373:             else {
     374:                 *tp= '\0';
     375:                 concat_to(&t, txdbuf);
     376:                 t= concat(t1= t, t2= conversion(q));
     377:                 release(t1); release(t2);
     378:                 tp= txdbuf; goto fbuf;
     379:             }
     380:         }
     381:         *tp++= Char(tx++);
     382:         if (tp+1 >= txdbufend) {
     383:             *(txdbufend-1)= '\0';
     384:             concat_to(&t, txdbuf);
     385:             tp= txdbuf;
     386:         }
     387:     }
     388:     if (tx >= q) parerr("cannot find matching ", aq);
     389:     if (++tx < q && Char(tx) == *aq) {
     390:         *tp++= Char(tx++);
     391:         goto fbuf;
     392:     }
     393:     *tp= '\0';
     394:     concat_to(&t, txdbuf);
     395:     return t;
     396: }
     397:
     398: Visible value conversion(q) txptr q; {
     399:     txptr f, t; value v, c;
     400:     thought('`');
     401:     req("`", q, &f, &t);
     402:     v= expr(f); c= Ifxeq(convert(v, Yes, Yes));
     403:     if (xeq) release(v);
     404:     tx= t; return c;
     405: }
     406:
     407: Hidden value tl_dis(q) txptr q; {
     408:     txptr f, t, ff, tt;
     409:     intlet len, k;
     410:     thought('{');
     411:     Skipsp(tx);
     412:     if (Char(tx) == '}') {
     413:         tx++;
     414:         return Ifxeq(mk_elt());
     415:     }
     416:     req("}", q, &f, &t);
     417:     if (find("..", f, &ff, &tt)) {
     418:         value enu, lo, hi;
     419:         lo= basexpr(ff);
     420:         if (!xeq || Is_number(lo)) {
     421:             tx= tt; while (Char(tx) == '.') tx++;
     422:             hi= basexpr(f);
     423:             if (xeq) {
     424:                 value entries;
     425:                 if (!integral(lo))
     426:                   error("in {p..q}, p is a number but not an integer");
     427:                 if (!Is_number(hi))
     428:                   error("in {p..q}, p is a number but q is not");
     429:                 if (!integral(hi))
     430:                   error("in {p..q}, q is a number but not an integer");
     431:                 entries= diff(lo, hi);
     432:                 if (compare(entries, one)>0)
     433:                     error("in {p..q}, integer q < x < p");
     434:                 enu= mk_numrange(lo, hi);
     435:                 release(entries);
     436:             } else enu= mk_elt();
     437:             release(hi); release(lo);
     438:         } else if (Is_text(lo)) {
     439:             char a, z;
     440:             if (!character(lo))
     441:               error("in {p..q}, p is a text but not a character");
     442:             tx= tt; hi= basexpr(f);
     443:             if (!Is_text(hi))
     444:               error("in {p..q}, p is a text but q is not");
     445:             if (!character(hi))
     446:               error("in {p..q}, q is a text but not a character");
     447:             a= charval(lo); z= charval(hi);
     448:             if (z < a-1) error("in {p..q}, character q < x < p");
     449:             enu= mk_charrange(lo, hi);
     450:             release(lo); release(hi);
     451:         } else error("in {p..q}, p is neither a number nor a text");
     452:         tx= t; return enu;
     453:     }
     454:     len= 1+count(";", f);
     455:     Skipsp(tx);
     456:     if (Char(tx) == '[') {
     457:         value ta, ke, a;
     458:         ta= mk_elt();
     459:         k_Over_len {
     460:             Skipsp(tx);
     461:             need("[");
     462:             req("]", f, &ff, &tt);
     463:             ke= expr(ff); tx= tt;
     464:             need(":");
     465:             if (Last(k)) {ff= f; tt= t;}
     466:             else req(";", f, &ff, &tt);
     467:             a= basexpr(ff); tx= tt;
     468:             replace(a, &ta, ke);
     469:             release(ke); release(a);
     470:         }
     471:         return ta;
     472:     }
     473:     {value l, v;
     474:         l= mk_elt();
     475:         k_Over_len {
     476:             if (Last(k)) {ff= f; tt= t;}
     477:             else req(";", f, &ff, &tt);
     478:             v= basexpr(ff); tx= tt;
     479:             insert(v, &l);
     480:             release(v);
     481:         }
     482:         return l;
     483:     }
     484: }

#### Defined functions

basexpr defined in line 112; used 8 times

- in line 89, 100-105(2), 419-422(2), 442, 467, 478

clocondis defined in line 182; used 2 times

- in line 121, 237

concat_to defined in line 358; used 7 times

- in line 375, 384, 394
- in /usr/src/new/PORT/B/src/bsmall/b2syn.c line 141-146(2), 158-163(2)

constant defined in line 324; used 2 times

- in line 193
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 52

conversion defined in line 398; used 2 times

- in line 376
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 53

expr defined in line 98; used 20 times

- in line 188, 243, 402, 463
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 61, 103, 133, 144, 161, 175, 185, 213, 282, 334, 443
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 49
- in /usr/src/new/PORT/B/src/bsmall/b2sou.c line 401
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 59
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 161
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 207

inittors defined in line 30; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2mai.c line 103

obasexpr defined in line 132; used 6 times

- in line 113
- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 50
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 75, 82-85(2), 101

pop_stack defined in line 36; used 3 times

- in line 47, 73, 84

popnd defined in line 43; used 4 times

- in line 77-78(2), 126-127(2)

primary defined in line 207; used 3 times

- in line 121, 137, 293

pushdyator defined in line 63; used 3 times

- in line 126, 165, 173

pushmontor defined in line 57; used 6 times

- in line 75, 123, 143, 151, 299, 307

pushnd defined in line 51; used 5 times

- in line 79, 123-126(2), 164, 172

statabsel defined in line 93; used 1 times

- in line 251

text_dis defined in line 367; used 2 times

- in line 90, 197

tl_dis defined in line 407; used 2 times

- in line 91, 201

trimbc defined in line 274; used 2 times

- in line 260
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 71

trimi defined in line 288; used 2 times

- in line 272, 279

#### Defined variables

txdbuf defined in line 355; used 7 times

- in line 356, 368, 375-378(2), 384-385(2), 394

txdbufend defined in line 356; used 2 times

- in line 382-383(2)

#### Defined macros

Bot defined in line 27; used 2 times

- in line 123-127(2)

Fpush defined in line 125; used 2 times

- in line 178, 310

Ipush defined in line 124; used 6 times

- in line 142, 150, 163, 171, 298, 306

Pbot defined in line 123; used 1 times

- in line 124

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