# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b3in2.c

##### Functions

    c_range           X
    i_range           X
    in_ranger         X
    l_mystery         X
    mk_range          X
    nl                X
    pa_ranger         X
    v_global          X
    v_local           X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
       2:
       3: /*
       4:   $Header: b3in2.c,v 1.4 85/08/22 16:58:21 timo Exp $
       5: */
       6:
       7: /* B interpreter -- independent subroutines */
       8:
       9: #include "b.h"
      10: #include "b1obj.h"
      11: #include "b3env.h"
      12: #include "b3in2.h"
      13: #include "b3sem.h"
      14: #include "b3sou.h"
      15:
      16: /* Making ranges */
      17:
      18: Hidden value c_range(lo, hi) value lo, hi; {
      19:     char a, z;
      20:     if (!character(lo))
      21:         error(MESS(3400, "in {p..q}, p is a text but not a character"));
      22:     else if (!Is_text(hi))
      23:         error(MESS(3401, "in {p..q}, p is a text, but q is not"));
      24:     else if (!character(hi))
      25:         error(MESS(3402, "in {p..q}, q is a text, but not a character"));
      26:     else {
      27:         a= charval(lo); z= charval(hi);
      28:         if (z < a-1) error(MESS(3403, "in {p..q}, character q < x < p"));
      29:         else return mk_charrange(lo, hi);
      30:     }
      31:     return Vnil;
      32: }
      33:
      34: Hidden value i_range(lo, hi) value lo, hi; {
      35:     value entries, res= Vnil;
      36:     if (!integral(lo))
      37:         error(MESS(3404, "in {p..q}, p is a number but not an integer"));
      38:     else if (!Is_number(hi))
      39:         error(MESS(3405, "in {p..q}, p is a number but q is not"));
      40:     else if (!integral(hi))
      41:         error(MESS(3406, "in {p..q}, q is a number but not an integer"));
      42:     else {
      43:         entries= diff(lo, hi);
      44:         if (compare(entries, one)>0)
      45:             error(MESS(3407, "in {p..q}, integer q < x < p"));
      46:         else res= mk_numrange(lo, hi);
      47:         release(entries);
      48:     }
      49:     return res;
      50: }
      51:
      52: Visible value mk_range(v1, v2) value v1, v2; {
      53:     value r= Vnil;
      54:     if (Is_text(v1)) r= c_range(v1, v2);
      55:     else if (Is_number(v1)) r= i_range(v1, v2);
      56:     else error(MESS(3408, "in {p..q}, p is neither a text nor a number"));
      57:     return r;
      58: }
      59:
      60:
      61: /* Newlines for WRITE /// */
      62:
      63: Visible Procedure nl(n) value n; {
      64:     value l= size(n); int c= intval(l); release(l);
      65:     while (c--) newline();
      66: }
      67:
      68:
      69: /* Evaluating basic targets */
      70:
      71: Visible value v_local(name, number) value name, number; {
      72:     value *aa= envassoc(curnv->tab, number);
      73:     if (aa != Pnil && *aa != Vnil) return copy(*aa);
      74:     error3(0, name, MESS(3409, " has not yet received a value"));
      75:     return Vnil;
      76: }
      77:
      78: Visible value v_global(name) value name; {
      79:     value *aa= envassoc(prmnv->tab, name);
      80:     if (aa != Pnil && *aa != Vnil) return copy(tarvalue(name, *aa));
      81:     error3(0, name, MESS(3410, " has not yet received a value"));
      82:     return Vnil;
      83: }
      84:
      85:
      86: /* Locating mysteries */
      87:
      88: Visible loc l_mystery(name, number) value name, number; {
      89:     if (Is_compound(curnv->tab)) return local_loc((basidf) number);
      90:     return global_loc(name);
      91: }
      92:
      93:
      94: /* Rangers */
      95:
      96: /* An IN-ranger is represented on the stack as a compound of three fields:
      97:    the last index used, the value of the expression after IN, and its length.
      98:    (The latter is redundant, but saves save many calls of 'size()'.)
      99:    When first called, there is, of course, no compound on the stack, but only
     100:    the value of the expression.  As the expression should always be a text,
     101:    list or table, this is recognizable as a special case, and then the
     102:    compound is created.
     103:    Return value is Yes if a new element was available and assigned, No if not.
     104: */
     105:
     106: Visible bool in_ranger(l, pv) loc l; value *pv; {
     107:     value v= *pv, ind, tlt, len, i1, val; bool res;
     108:     if (!Is_compound(v) || Nfields(v) != 3) { /* First time */
     109:         tlt= v;
     110:         if (!Is_tlt(tlt)) {
     111:             error(MESS(3411, "in ... i IN e, e is not a text, list or table"));
     112:             return No;
     113:         }
     114:         if (empty(tlt)) return No;
     115:         *pv= v= mk_compound(3);
     116:         *Field(v, 0)= ind= one;
     117:         *Field(v, 1)= tlt;
     118:         *Field(v, 2)= len= size(tlt);
     119:         bind(l);
     120:     }
     121:     else {
     122:         ind= *Field(v, 0); tlt= *Field(v, 1); len= *Field(v, 2);
     123:         res= numcomp(ind, len) < 0;
     124:         if (!res) { unbind(l); return No; }
     125:         *Field(v, 0)= ind= sum(i1= ind, one); release(i1);
     126:     }
     127:     put(val= th_of(ind, tlt), l); release(val);
     128:     return Yes;
     129: }
     130:
     131:
     132: /* PARSING-rangers are treated similarly to IN-rangers, but here the
     133:    compound contains the last parse (i.e., N texts). */
     134:
     135: Visible bool pa_ranger(l, pv) loc l; value *pv; {
     136:     value v= *pv, e, f; int len, k;
     137:     if (!Is_compound(v)) {
     138:         if (!Is_text(v)) {
     139:             error(MESS(3412, "in  ... i PARSING e, e is not a text"));
     140:             return No;
     141:         }
     142:         if (!Is_compound(l)) {
     143:             error(
     144:         MESS(3413, "in ... i PARSING e, i is not a collateral identifier"));
     145:             return No;
     146:         }
     147:         v= mk_compound(len= Nfields(l));
     148:         *Field(v, len-1)= *pv;
     149:         *Field(v, 0)= e= mk_text("");
     150:         for (k= 1; k < len-1; ++k)
     151:             *Field(v, k)= copy(e);
     152:         *pv= v;
     153:         bind(l);
     154:         put(v, l);
     155:         return Yes;
     156:     }
     157:     uniql(pv); v= *pv;
     158:     len= Nfields(v);
     159:     for (k= len-1; k > 0; --k) {
     160:         if (!empty(f= *Field(v, k))) {
     161:             value head, tail, prev, newprev, two= sum(one, one);
     162:             head= curtail(f, one); tail= behead(f, two);
     163:             release(f);
     164:             newprev= concat(prev= *Field(v, k-1), head);
     165:             release(prev); release(head);
     166:             *Field(v, k-1)= newprev;
     167:             if (k < len-1)
     168:                 *Field(v, k)= *Field(v, len-1);
     169:             *Field(v, len-1)= tail;
     170:             put(v, l);
     171:             return Yes;
     172:         }
     173:     }
     174:     unbind(l);
     175:     return No;
     176: }

#### Defined functions

c_range defined in line 18; used 1 times

- in line 54

i_range defined in line 34; used 1 times

- in line 55

in_ranger defined in line 106; used 3 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 13
- in /usr/src/new/PORT/B/src/bint/b3int.c line 157, 312

l_mystery defined in line 88; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 11
- in /usr/src/new/PORT/B/src/bint/b3int.c line 360

mk_range defined in line 52; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 12
- in /usr/src/new/PORT/B/src/bint/b3int.c line 281

nl defined in line 63; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3int.c line 171-173(2)

pa_ranger defined in line 135; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 14
- in /usr/src/new/PORT/B/src/bint/b3int.c line 323

v_global defined in line 78; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 10
- in /usr/src/new/PORT/B/src/bint/b3int.c line 356

v_local defined in line 71; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3in2.h line 9
- in /usr/src/new/PORT/B/src/bint/b3int.c line 352

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