/*
 * File: oref.c
 *  Contents: bang, random, sect, subsc
 */

#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"


/*
 * !x - generate successive values from object x.
 */

OpDcl(bang,1,"!")
   {
   register word i, j, slen, rlen;
   register union block *bp;
   register dptr dp;
   register char *sp;
   int typ1;
   char sbuf[MaxCvtLen];
   FILE *fd;

#ifdef RecordIO
   word status;
#endif					/* RecordIO */

   Arg2 = Arg1;

   if (DeRef(Arg1) == Error) 
      RunErr(0, NULL);
   if ((typ1 = cvstr(&Arg1, sbuf)) != CvtFail) {
      /*
       * A string is being banged.
       */
      i = 1;
      while (i <= StrLen(Arg1)) {
         /*
          * Loop through the string using i as an index.
          */
         if (typ1 == Cvt) {
            /*
             * Arg1 was converted to a string, thus, the resulting string
             *	cannot be modified and a trapped variable is not needed.
             *	Make a one-character string out of the next character
             *	in Arg1 and suspend it.
             */
            if (strreq((word)1) == Error) 
               RunErr(0, NULL);
            StrLen(Arg0) = 1;
            StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
            Suspend;
            }
         else {
            /*
             * Arg1 is a string and thus a trapped variable must be made
             *	for the one character string being suspended.
             */
            if (blkreq((word)sizeof(struct b_tvsubs)) == Error) 
               RunErr(0, NULL);
            mksubs(&Arg2, &Arg1, i, (word)1, &Arg0);
            Suspend;
            Arg1 = Arg2;
            if (DeRef(Arg1) == Error) 
               RunErr(0, NULL);
            if (!Qual(Arg1)) 
               RunErr(103, &Arg1);
            }
         i++;
         }
      }
   else {
      /*
       * Arg1 is not a string.
       */
      switch (Type(Arg1)) {
         case T_List:
            /*
             * Arg1 is a list.  Chain through each list element block and for
             *	each one, suspend with a variable pointing to each
             *	element contained in the block.
             */
            bp = BlkLoc(Arg1);
            for (bp = bp->list.listhead; bp != NULL; bp = bp->lelem.listnext) {
               for (i = 0; i < bp->lelem.nused; i++) {
                  j = bp->lelem.first + i;
                  if (j >= bp->lelem.nslots)
                     j -= bp->lelem.nslots;
                  dp = &bp->lelem.lslots[j];
                  Arg0.dword = D_Var + ((word *)dp - (word *)bp);
                  VarLoc(Arg0) = (dptr)bp;
		  BlkLoc(Arg1) = bp;     /* save in Arg1 since bp is untended */
                  Suspend;
                  bp = BlkLoc(Arg1);	 /* bp is untended, must reset */
                  }
               }
            break;


         case T_File:
            /*
             * Arg1 is a file.  Read the next line into the string space
             *  and suspend the newly allocated string.
             */
            fd = BlkLoc(Arg1)->file.fd;

#ifdef RecordIO
            status = BlkLoc(Arg1)->file.status;
#endif					/* RecordIO */

            if ((BlkLoc(Arg1)->file.status & Fs_Read) == 0)
               RunErr(212, &Arg1);

#ifdef StandardLib
            if (BlkLoc(Arg1)->file.status & Fs_Writing) {
               fseek(fd, 0L, SEEK_CUR);
               BlkLoc(Arg1)->file.status &= ~Fs_Writing;
            }
            BlkLoc(Arg1)->file.status |= Fs_Reading;
#endif					/* StandardLib */

            for (;;) {
               StrLen(Arg0) = 0;
               do {

#ifdef RecordIO
                  if ((slen = (status & Fs_Record ?
                               getrec(sbuf, MaxCvtLen, fd) :
                               getstrg(sbuf, MaxCvtLen, fd))) == -1)
#else					/* RecordIO */
                  if ((slen = getstrg(sbuf,MaxCvtLen,fd)) == -1)
#endif                                  /* RecordIO */
                     Fail;
		  rlen = slen < 0 ? (word)MaxCvtLen : slen;
                  if (strreq(rlen) == Error) 
                     RunErr(0, NULL);
		  sp = alcstr(sbuf,rlen);
		  if (StrLen(Arg0) == 0)
                     StrLoc(Arg0) = sp;
		  StrLen(Arg0) += rlen;
		  } while (slen < 0);
                  Suspend;
               }
            break;

         case T_Table:
            /*
             * Arg1 is a table.  Generate the element values.
             */
            MakeInt(2, &Arg2);		/* indicate that we want the values */
            Forward(hgener);		/* go to the hash generator */

         case T_Set:
            /*
             * Arg1 is a set.  Generate the element values.
             */
            MakeInt(0, &Arg2);		/* indicate that we want set elements */
            Forward(hgener);		/* go to the hash generator */

         case T_Record:
            /*
             * Arg1 is a record.  Loop through the fields and suspend
             *	a variable pointing to each one.
             */
            bp = BlkLoc(Arg1);
            j = bp->record.recdesc->proc.nfields;
            for (i = 0; i < j; i++) {
               dp = &bp->record.fields[i];
               Arg0.dword = D_Var + ((word *)dp - (word *)bp);
               VarLoc(Arg0) = (dptr)bp;
               Suspend;
               bp = BlkLoc(Arg1);        /* bp is untended, must reset */
               }
            break;

         default: /* This object can not be compromised. */
            RunErr(116, &Arg1);
         }
      }

   /*
    * Eventually fail.
    */
   Fail;
   }

#define RandVal (RanScale*(k_random=(RandA*(long)k_random+RandC)&0x7fffffffL))

/*
 * ?x - produce a randomly selected element of x.
 */

OpDcl(random,1,"?")
   {
   register word val, i, j, n;
   register union block *bp, *ep;
   struct b_slots *seg;
   char sbuf[MaxCvtLen];
   dptr dp;
   double rval;

   Arg2 = Arg1;
   if (DeRef(Arg1) == Error) 
      RunErr(0, NULL);

   if (Qual(Arg1)) {
      /*
       * Arg1 is a string, produce a random character in it as the result.
       *  Note that a substring trapped variable is returned.
       */
      if ((val = StrLen(Arg1)) <= 0)
         Fail;
      if (blkreq((word)sizeof(struct b_tvsubs)) == Error) 
         RunErr(0, NULL);
      rval = RandVal;			/* This form is used to get around */
      rval *= val;			/* a bug in a certain C compiler */
      mksubs(&Arg2, &Arg1, (word)rval + 1, (word)1, &Arg0);
      Return;
      }

   switch (Type(Arg1)) {
      case T_Cset:
         /*
          * Arg1 is a cset.  Convert it to a string, select a random character
          *  of that string and return it.  Note that a substring trapped
          *  variable is not needed.
          */
         cvstr(&Arg1, sbuf);
         if ((val = StrLen(Arg1)) <= 0)
            Fail;
         if (strreq((word)1) == Error) 
            RunErr(0, NULL);
         StrLen(Arg0) = 1;
         rval = RandVal;
         rval *= val;
         StrLoc(Arg0) = alcstr(StrLoc(Arg1)+(word)rval, (word)1);
         Return;


      case T_List:
         /*
          * Arg1 is a list.  Set i to a random number in the range [1,*Arg1],
          *  failing if the list is empty.
          */
         bp = BlkLoc(Arg1);
         val = bp->list.size;
         if (val <= 0)
            Fail;
         rval = RandVal;
         rval *= val;
         i = (word)rval + 1;
         j = 1;
         /*
          * Work down chain list of list blocks and find the block that
          *  contains the selected element.
          */
         bp = bp->list.listhead;
         while (i >= j + bp->lelem.nused) {
            j += bp->lelem.nused;
            bp = bp->lelem.listnext;
            if (bp == NULL)
               syserr("list reference out of bounds in random");
            }
         /*
          * Locate the appropriate element and return a variable
          * that points to it.
          */
         i += bp->lelem.first - j;
         if (i >= bp->lelem.nslots)
            i -= bp->lelem.nslots;
         dp = &bp->lelem.lslots[i];
         Arg0.dword = D_Var + ((word *)dp - (word *)bp);
         VarLoc(Arg0) = (dptr)bp;
         Return;

      case T_Table:
      case T_Set:
          /*
           * Arg1 is a table or a set.  Set n to a random number in the range
           *  [1,*Arg1], failing if the structure is empty.
           */
         bp = BlkLoc(Arg1);
         val = bp->table.size;
         if (val <= 0)
            Fail;
         rval = RandVal;
         rval *= val;
         n = (word)rval + 1;
         /*
          * Walk down the hash chains to find and return the n'th element.
          */
         for (i = 0; i < HSegs && (seg = bp->table.hdir[i]) != NULL; i++)
            for (j = segsize[i] - 1; j >= 0; j--)
               for (ep = seg->hslots[j]; ep != NULL; ep = ep->telem.clink)
                  if (--n <= 0) {
                     if (Type(Arg1) == T_Set) {
                        /*
                         * For a set, return the element value.
                         */
                        Arg0 = ep->selem.setmem;
                        }
                     else {
                        /*
                         * For a table, return a variable pointing to the
                         *  selected element.
                         */
                        dp = &ep->telem.tval;
                        Arg0.dword = D_Var + ((word *)dp - (word *)bp);
                        VarLoc(Arg0) = (dptr)bp;
                        }
                     Return;
                     }

      case T_Record:
         /*
          * Arg1 is a record.  Set val to a random number in the range
          *  [1,*Arg1] (*Arg1 is the number of fields), failing if the
          *  record has no fields.
          */
         bp = BlkLoc(Arg1);
         val = bp->record.recdesc->proc.nfields;
         if (val <= 0)
            Fail;
         /*
          * Locate the selected element and return a variable
          * that points to it
          */
            rval = RandVal;
            rval *= val;
            dp = &bp->record.fields[(word)rval];
            Arg0.dword = D_Var + ((word *)dp - (word *)bp);
            VarLoc(Arg0) = (dptr)bp;
            Return;

#ifdef LargeInts
      case T_Bignum:
	 if (bigrand(&Arg1, &Arg0) == Error)  /* alcbignum failed */
	    RunErr(0, NULL);
	 Return;
#endif					/* LargeInts */

      default:
         /*
          * Try converting it to an integer
          */
      switch (cvint(&Arg1)) {

         case T_Integer:
            /*
             * Arg1 is an integer, be sure that it's non-negative.
             */
            val = (word)IntVal(Arg1);
            if (val < 0)
               RunErr(205, &Arg1);

            /*
             * val contains the integer value of Arg1.	If val is 0, return
             *	a real in the range [0,1], else return an integer in the
             *	range [1,val].
             */
            if (val == 0) {
               rval = RandVal;
               if (makereal(rval, &Arg0) == Error) 
                  RunErr(0, NULL);
               }
            else {
               rval = RandVal;
               rval *= val;
               MakeInt((long)rval + 1, &Arg0);
               }
            Return;

         default:
            /*
             * Arg1 is of a type for which random generation is not supported
             */
            RunErr(113, &Arg1);
            }
         }
   }

/*
 * x[i:j] - form a substring or list section of x.
 */

OpDcl(sect,3,"[:]")
   {
   register word i, j, t;
   int typ1;
   char sbuf[MaxCvtLen];

   if (blkreq((word)sizeof(struct b_tvsubs)) == Error) 
      RunErr(0, NULL);

   if (cvint(&Arg2) == CvtFail) 
      RunErr(101, &Arg2);
   if (cvint(&Arg3) == CvtFail) 
      RunErr(101, &Arg3);

   Arg4 = Arg1;
   if (DeRef(Arg1) == Error) 
      RunErr(0, NULL);

   if (Arg1.dword == D_List) {
      i = cvpos(IntVal(Arg2), BlkLoc(Arg1)->list.size);
      if (i == CvtFail)
         Fail;
      j = cvpos(IntVal(Arg3), BlkLoc(Arg1)->list.size);
      if (j == CvtFail)
         Fail;
      if (i > j) {
         t = i;
         i = j;
         j = t;
         }
      if (cplist(&Arg1, &Arg0, i, j) == Error) 
         RunErr(0, NULL);
      Return;
      }

   if ((typ1 = cvstr(&Arg1, sbuf)) == CvtFail) 
      RunErr(110, &Arg1);

   i = cvpos(IntVal(Arg2), StrLen(Arg1));
   if (i == CvtFail)
      Fail;
   j = cvpos(IntVal(Arg3), StrLen(Arg1));
   if (j == CvtFail)
      Fail;
   if (i > j) { 			/* convert section to substring */
      t = i;
      i = j;
      j = t - j;
      }
   else
      j = j - i;

   if (typ1 == Cvt) {
      /*
       * A string was created - just return a string
       */
      if (strreq(j) == Error) 
         RunErr(0, NULL);
      StrLen(Arg0) = j;
      StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, j);
      }
   else 				/* else make a substring tv */
      mksubs(&Arg4, &Arg1, i, j, &Arg0);
   Return;
   }

/*
 * x[y] - access yth character or element of x.
 */

OpDcl(subsc,2,"[]")
   {
   register word i, j;
   register union block *bp;
   register uword hn;
   int typ1, res;
   dptr dp;
   union block **dp1;
   char sbuf[MaxCvtLen];

   /*
    * Make a copy of Arg1.
    */
   Arg3 = Arg1;

   if (DeRef(Arg1) == Error) 
      RunErr(0, NULL);
   if ((typ1 = cvstr(&Arg1, sbuf)) != CvtFail) {
      /*
       * Arg1 is a string, make sure that Arg2 is an integer.
       */
      if (cvint(&Arg2) == CvtFail) 
         RunErr(101, &Arg2);

      /*
       * Convert Arg2 to a position in Arg1 and fail if the position is out
       *  of bounds.
       */
      i = cvpos(IntVal(Arg2), StrLen(Arg1));
      if (i == CvtFail || i > StrLen(Arg1))
         Fail;
      if (typ1 == Cvt) {
         /*
          * Arg1 was converted to a string, so it cannot be assigned back into.
          *  Just return a string containing the selected character.
          */
         if (strreq((word)1) == Error) 
            RunErr(0, NULL);
         StrLen(Arg0) = 1;
         StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
         }
      else {
         /*
          * Arg1 is a string, make a substring trapped variable for the one
          *  character substring selected and return it.
          */
         if (blkreq((word)sizeof(struct b_tvsubs)) == Error) 
            RunErr(0, NULL);
         mksubs(&Arg3, &Arg1, i, (word)1, &Arg0);
         }
      Return;
      }

   /*
    * Arg1 is not a string or convertible to one, see if it's an aggregate.
    */
   switch (Type(Arg1)) {
      case T_List:
         /*
          * Make sure that Arg2 is an integer and that the
          *  subscript is in range.
          */
         if (cvint(&Arg2) == CvtFail) 
            RunErr(101, &Arg2);
         i = cvpos(IntVal(Arg2), BlkLoc(Arg1)->list.size);
         if (i == CvtFail || i > BlkLoc(Arg1)->list.size)
            Fail;

         /*
          * Locate the list-element block containing the desired
          *  element.
          */
         bp = BlkLoc(Arg1)->list.listhead;
         j = 1;
         while (bp != NULL && i >= j + bp->lelem.nused) {
            j += bp->lelem.nused;
            bp = bp->lelem.listnext;
            }

         /*
          * Locate the desired element and return a pointer to it.
          */
         i += bp->lelem.first - j;
         if (i >= bp->lelem.nslots)
            i -= bp->lelem.nslots;
         dp = &bp->lelem.lslots[i];
         Arg0.dword = D_Var + ((word *)dp - (word *)bp);
         VarLoc(Arg0) = (dptr)bp;
         Return;

      case T_Table:
         /*
          * Arg1 is a table.  Locate the appropriate bucket
          *  based on the hash value.
          */
         if (blkreq((word)sizeof(struct b_tvtbl)) == Error) 
            RunErr(0, NULL);
         hn = hash(&Arg2);
         dp1 = memb(BlkLoc(Arg1), &Arg2, hn, &res);
         if (res == 1) {
            bp = *dp1;
            dp = &bp->telem.tval;
            Arg0.dword = D_Var + ((word *)dp - (word *)bp);
            VarLoc(Arg0) = (dptr)bp;
            }
         else {
            /*
             * Arg1[Arg2] is not in the table, make a table element trapped
             *  variable and return it as the result.
             */
            Arg0.dword = D_Tvtbl;
            BlkLoc(Arg0) = (union block *)alctvtbl(&Arg1, &Arg2, hn);
            }
         Return;

      case T_Record:
         /*
          * Arg1 is a record.  Convert Arg2 to an integer and be sure that it
          *  it is in range as a field number.
          */
         if (cvint(&Arg2) == CvtFail) 
            RunErr(101, &Arg2);
         bp = BlkLoc(Arg1);
         i = cvpos(IntVal(Arg2), (word)(bp->record.recdesc->proc.nfields));
         if (i == CvtFail || i > bp->record.recdesc->proc.nfields)
            Fail;
         /*
          * Locate the appropriate field and return a pointer to it.
          */
         dp = &bp->record.fields[i-1];
         Arg0.dword = D_Var + ((word *)dp - (word *)bp);
         VarLoc(Arg0) = (dptr)bp;
         Return;

      default:
         /*
          * Arg1 is of a type that cannot be subscripted.
          */
         RunErr(114, &Arg1);
      }
   }