Return to random.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / operators

Annotation of 43BSD/contrib/icon/operators/random.c, revision 1.1

1.1     ! root        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)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.