/*
 * File: omisc.c
 *  Contents: refresh, size, tabmat, toby
 */

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


/*
 * ^x - return an entry block for co-expression x from the refresh block.
 */

OpDcl(refresh,1,"^")
   {

#ifdef Coexpr
   register struct b_coexpr *sblkp;
   register struct b_refresh *rblkp;
   register dptr dp, dsp;
   register word *newsp;
   int na, nl, i;

   /*
    * Be sure a co-expression is being refreshed.
    */
   if (Qual(Arg1) || Arg1.dword != D_Coexpr) 
      RunErr(118, &Arg1);

   /*
    * Get a new co-expression stack and initialize.
    */
   if ((sblkp = alccoexp()) == NULL) 
      RunErr(0, NULL);
   sblkp->freshblk = BlkLoc(Arg1)->coexpr.freshblk;
   if (ChkNull(sblkp->freshblk))	/* &main cannot be refreshed */
      RunErr(215, &Arg1);

   /*
    * The interpreter stack starts at word after co-expression stack block.
    *  C stack starts at end of stack region on machines with down-growing C
    *  stacks and somewhere in the middle of the region.
    *
    * The C stack is aligned on a doubleword boundary.	For upgrowing
    *  stacks, the C stack starts in the middle of the stack portion
    *  of the static block.  For downgrowing stacks, the C stack starts
    *  at the last word of the static block.
    */
   newsp = (word *)((word)(char *)sblkp + sizeof(struct b_coexpr));

#ifdef UpStack
   sblkp->cstate[0] =
      ((word)((word)(char *)sblkp + (stksize - sizeof(*sblkp))/2)
       &~(WordSize*StackAlign-1));
#else					/* UpStack */
   sblkp->cstate[0] =
    ((word)((word)(char *)sblkp + stksize - WordSize)&~(WordSize*StackAlign-1));
#endif					/* UpStack */

#ifdef CoProcesses
   sblkp->cstate[1] = 0;
#endif


   sblkp->es_argp = (dptr)newsp;

   /*
    * Get pointer to refresh block and get number of arguments and locals.
    */

   rblkp = (struct b_refresh *)BlkLoc(sblkp->freshblk);
   na = (rblkp->pfmkr).pf_nargs + 1;
   nl = (int)rblkp->numlocals;

   /*
    * Copy arguments onto new stack.
    */
   dp = &rblkp->elems[0];
   dsp = (dptr)newsp;
   for (i = 1; i <= na; i++)
      *dsp++ = *dp++;

   /*
    * Copy procedure frame to new stack and point dsp to word after frame.
    */
   *((struct pf_marker *)dsp) = rblkp->pfmkr;
   sblkp->es_pfp = (struct pf_marker *)dsp;
/*   dsp = (dptr)((word *)dsp + Vwsizeof(*pfp)); */
   dsp = (dptr)((word)dsp + sizeof(word) * Vwsizeof(*pfp));
   sblkp->es_ipc.opnd = rblkp->ep;
   sblkp->es_gfp = 0;
   sblkp->es_efp = 0;
   sblkp->tvalloc = NULL;
   sblkp->es_ilevel = 0;

   /*
    * Copy locals to new stack and refresh block.
    */
   for (i = 1; i <= nl; i++)
      *dsp++ = *dp++;

   /*
    * Push two null descriptors on the stack.
    */
   *dsp++ = nulldesc;
   *dsp++ = nulldesc;

   sblkp->es_sp = (word *)dsp - 1;

   /*
    * Return the new co-expression.
    */
   Arg0.dword = D_Coexpr;
   BlkLoc(Arg0) = (union block *) sblkp;
   Return;

#else					/* Coexpr */
   RunErr(-401, NULL);
#endif					/* Coexpr */

   }

/*
 * *x - return size of string or object x.
 */

OpDcl(size,1,"*")
   {
   char sbuf[MaxCvtLen];
   word i;
   int j;
   union block *bp;

   if (Qual(Arg1)) {
      /*
       * If Arg1 is a string, return the length of the string.
       */
      i = StrLen(Arg1);
      }

   else {
      /*
       * Arg1 is not a string.  For most types, the size is in the size
       *  field of the block.
       *  structure.
       */
      switch (Type(Arg1)) {
         case T_List:
            i = BlkLoc(Arg1)->list.size;
            break;

         case T_Table:
            i = BlkLoc(Arg1)->table.size;
            break;

         case T_Set:
            i = BlkLoc(Arg1)->set.size;
            break;

         case T_Cset: {
	    register unsigned int w;

            i = BlkLoc(Arg1)->cset.size;
            if (i >= 0)
               break;
            bp = (union block *)BlkLoc(Arg1);
            i = 0;
            for (j = 0; j < CsetSize; j++)
	       for (w=bp->cset.bits[j]; w; w >>= 1)
		  if (w & 01)
		     i++;
            bp->cset.size = i;
            break;
	    }

         case T_Record:
            i = BlkLoc(Arg1)->record.recdesc->proc.nfields;
            break;

         case T_Coexpr:

            i = BlkLoc(Arg1)->coexpr.size;
            break;

         default:
            /*
             * Try to convert it to a string.
             */
            if (cvstr(&Arg1, sbuf) == CvtFail) 
               RunErr(112, &Arg1);	/* no notion of size */
            i = StrLen(Arg1);
         }
      }
   MakeInt(i, &Arg0);
   Return;
   }

/*
 * =x - tab(match(x)).  Reverses effects if resumed.
 */

OpDcl(tabmat,1,"=")
   {
   register word l;
   register char *s1, *s2;
   word i, j;
   char sbuf[MaxCvtLen];
   int type;

   /*
    * Arg1 must be a string.
    */
   if ((type = cvstr(&Arg1,sbuf)) == CvtFail) 
      RunErr(103, &Arg1);

   /*
    * Make a copy of &pos.
    */
   i = k_pos;

   /*
    * Fail if &subject[&pos:0] is not of sufficient length to contain Arg1.
    */
   j = StrLen(k_subject) - i + 1;
   if (j < StrLen(Arg1))
      Fail;

   /*
    * Get pointers to Arg1 (s1) and &subject (s2).  Compare them on a bytewise
    *  basis and fail if s1 doesn't match s2 for *s1 characters.
    */
   s1 = StrLoc(Arg1);
   s2 = StrLoc(k_subject) + i - 1;
   l = StrLen(Arg1);
   while (l-- > 0) {
      if (*s1++ != *s2++)
         Fail;
      }

   /*
    * Increment &pos to tab over the matched string and suspend the
    *  matched string.
    */
   l = StrLen(Arg1);
   k_pos += l;
   Arg0 = Arg1;
   if (type == Cvt) {		/* string is in buffer, copy */
      if (strreq(StrLen(Arg0)) == Error) 
         RunErr(0, NULL);
      StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
      }
   Suspend;

   /*
    * tabmat has been resumed, restore &pos and fail.
    */
   if (i > StrLen(k_subject) + 1) {
      RunErr(205, &tvky_pos.kyval);
      }
   else
      k_pos = i;
   Fail;
   }

/*
 * i to j by k - generate successive values.
 */

OpDcl(toby,3,"...")
   {
   long from;

   /*
    * Arg1 (from), Arg2 (to), and Arg3 (by) must be integers.
    *  Also, Arg3 must not be zero.
    */
   if (cvint(&Arg1) == CvtFail) 
      RunErr(101, &Arg1);
   if (cvint(&Arg2) == CvtFail) 
      RunErr(101, &Arg2);
   if (cvint(&Arg3) == CvtFail) 
      RunErr(101, &Arg3);
   if (IntVal(Arg3) == 0) 
      RunErr(211, &Arg3);

   /*
    * Count up or down (depending on relationship of from and to) and
    *  suspend each value in sequence, failing when the limit has been
    *  exceeded.
    */
   from = IntVal(Arg1);
   if (IntVal(Arg3) > 0)
      for ( ; from <= IntVal(Arg2); from += IntVal(Arg3)) {
	 MakeInt(from, &Arg0);
         Suspend;
         }
   else
      for ( ; from >= IntVal(Arg2); from += IntVal(Arg3)) {
	 MakeInt(from, &Arg0);
         Suspend;
         }
   Fail;
   }