1: #include "../h/rt.h"
   2: #include "../h/record.h"
   3: #define randval (RSCALE*(k_random=(RANDA*k_random+RANDC)&MAXLONG))
   4: 
   5: /*
   6:  * ?x - produce a randomly selected element of x.
   7:  */
   8: 
   9: random(nargs, arg1v, arg1, arg0)
  10: int nargs;
  11: struct descrip arg1v, arg1, arg0;
  12:    {
  13:    register int val, i, j;
  14:    register union block *bp;
  15:    double r1;
  16:    char sbuf[MAXSTRING];
  17:    union block *ep;
  18:    struct descrip *dp;
  19:    extern char *alcstr();
  20: 
  21:    SetBound;
  22:    arg1v = arg1;
  23:    DeRef(arg1)
  24: 
  25:    /*
  26:     * x must not be null.
  27:     */
  28:    if (NULLDESC(arg1))
  29:       runerr(113, &arg1);
  30: 
  31:    if (QUAL(arg1)) {
  32:       /*
  33:        * x is a string, produce a random character in it as the result.
  34:        *  Note that a substring trapped variable is returned.
  35:        */
  36:       if ((val = STRLEN(arg1)) <= 0)
  37:          fail();
  38:       hneed(sizeof(struct b_tvsubs));
  39:       mksubs(&arg1v, &arg1, (int)(randval*val)+1, 1, &arg0);
  40:       ClearBound;
  41:       return;
  42:       }
  43: 
  44:    switch (TYPE(arg1)) {
  45:       case T_CSET:
  46:          /*
  47:           * x is a cset.  Convert it to a string, select a random character
  48:           *  of that string and return it.  Note that a substring trapped
  49:           *  variable is not needed.
  50:           */
  51:          cvstr(&arg1, sbuf);
  52:          if ((val = STRLEN(arg1)) <= 0)
  53:             fail();
  54:          sneed(1);
  55:          STRLEN(arg0) = 1;
  56:          STRLOC(arg0) = alcstr(STRLOC(arg1)+(int)(randval*val), 1);
  57:          ClearBound;
  58:          return;
  59: 
  60:       case T_REAL:
  61:          /*
  62:           * x is real.  Convert it to an integer and be sure that it is
  63:           *  non-negative and less than MAXSHORT.  Jump to common code
  64:           *  to compute a random value.  Note that reals are functionally
  65:           *  equivalent to integers.
  66:           */
  67:          r1 = BLKLOC(arg1)->realblk.realval;
  68:          if (r1 < 0 || r1 > MAXSHORT)
  69:             runerr(205, &arg1);
  70:          val = (int)r1;
  71:          goto getrand;
  72: 
  73:       case T_INTEGER:
  74:          /*
  75:           * x is an integer, be sure that it's non-negative.
  76:           */
  77:          val = INTVAL(arg1);
  78:          if (val < 0)
  79:             runerr(205, &arg1);
  80:       getrand:
  81:          /*
  82:           * val contains the integer value of x.  If val is 0, return
  83:           *  a real in the range [0,1), else return an integer in the
  84:           *  range [1,val].
  85:           */
  86:          if (val == 0)
  87:             mkreal(randval, &arg0);
  88:          else
  89:             mkint((long)(randval*val) + 1, &arg0);
  90:          ClearBound;
  91:          return;
  92: 
  93: #ifdef LONGS
  94:       case T_LONGINT:
  95:          /*
  96:           * Produce an error if x is a long integer.
  97:           */
  98:          runerr(205, &arg1);
  99: #endif LONGS
 100:       case T_LIST:
 101:          /*
 102:           * x is a list.  Set i to a random number in the range [1,*x],
 103:           *  failing if the list is empty.
 104:           */
 105:          bp = BLKLOC(arg1);
 106:          val = bp->list.cursize;
 107:          if (val <= 0)
 108:             fail();
 109:          i = (int)(randval*val) + 1;
 110:             j = 1;
 111:          /*
 112:           * Work down chain list of list blocks and find the block that
 113:           *  contains the selected element.
 114:           */
 115:             bp = BLKLOC(BLKLOC(arg1)->list.listhead);
 116:             while (i >= j + bp->lelem.nused) {
 117:                j += bp->lelem.nused;
 118:                if (TYPE(bp->lelem.listnext) != T_LELEM)
 119:                syserr("list reference out of bounds in random");
 120:                bp = BLKLOC(bp->lelem.listnext);
 121:             }
 122:          /*
 123:           * Locate the appropriate element and return a variable
 124:           * that points to it.
 125:           */
 126:             i += bp->lelem.first - j;
 127:          if (i >= bp->lelem.nelem)
 128:             i -= bp->lelem.nelem;
 129:          dp = &bp->lelem.lslots[i];
 130:          arg0.type = D_VAR + ((int *)dp - (int *)bp);
 131:          VARLOC(arg0) = dp;
 132:          ClearBound;
 133:             return;
 134: 
 135:       case T_TABLE:
 136:           /*
 137:            * x is a table.  Set i to a random number in the range [1,*x],
 138:            *  failing if the table is empty.
 139:            */
 140:           bp = BLKLOC(arg1);
 141:           val = bp->table.cursize;
 142:           if (val <= 0)
 143:              fail();
 144:           i = (int)(randval*val) + 1;
 145:           /*
 146:            * Work down the chain of elements in each bucket and return
 147:            *  a variable that points to the i'th element encountered.
 148:            */
 149:           for (j = 0; j < NBUCKETS; j++) {
 150:              for (ep = BLKLOC(bp->table.buckets[j]); ep != NULL;
 151:                      ep = BLKLOC(ep->telem.blink)) {
 152:                 if (--i <= 0) {
 153:                    dp = &ep->telem.tval;
 154:                    arg0.type = D_VAR + ((int *)dp - (int *)bp);
 155:                    VARLOC(arg0) = dp;
 156:                    ClearBound;
 157:                    return;
 158:                    }
 159:                 }
 160:              }
 161: #ifdef SETS
 162:       case T_SET:
 163:          /*
 164:           * x is a set.  Set i to a random number in the range [1,*x],
 165:           *  failing if the set is empty.
 166:           */
 167:          bp = BLKLOC(arg1);
 168:          val = bp->set.setsize;
 169:          if (val <= 0)
 170:             fail();
 171:          i = (int)(randval*val) + 1;
 172:          /*
 173:           * Work down the chain of elements in each bucket and return
 174:           *  the value of the i'th element encountered.
 175:           */
 176:          for (j = 0; j < NBUCKETS; j++) {
 177:             for (ep = BLKLOC(bp->set.sbucks[j]); ep != NULL;
 178:                ep = BLKLOC(ep->selem.sblink)) {
 179:                   if (--i <= 0) {
 180:                      arg0 = ep->selem.setmem;
 181:                      ClearBound;
 182:                      return;
 183:                      }
 184:                  }
 185:              }
 186: #endif SETS
 187: 
 188:       case T_RECORD:
 189:          /*
 190:           * x is a record.  Set val to a random number in the range [1,*x]
 191:           *  (*x is the number of fields), failing if the record has no
 192:           *  fields.
 193:           */
 194:          bp = BLKLOC(arg1);
 195:          val = bp->record.recptr->nfields;
 196:          if (val <= 0)
 197:             fail();
 198:          /*
 199:           * Locate the selected element and return a variable
 200:           * that points to it
 201:           */
 202:             dp = &bp->record.fields[(int)(randval*val)];
 203:               arg0.type = D_VAR + ((int *)dp - (int *)bp);
 204:          VARLOC(arg0) = dp;
 205:          ClearBound;
 206:             return;
 207: 
 208:       default:
 209:          /*
 210:           * x is of a type for which there is no notion of elements.
 211:           */
 212:          runerr(113, &arg1);
 213:       }
 214:    }
 215: 
 216: Opblockx(random,2,"?",1)

Defined functions

random defined in line 9; used 1 times

Defined macros

randval defined in line 3; used 8 times
Last modified: 1984-11-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1187
Valid CSS Valid XHTML 1.0 Strict