/*
 * File: fstranl.c
 *  Contents: any, bal, find, many, match, upto
 */

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


/*
 * any(c,s,i,j) - test if first character of s[i:j] is in c.
 */

FncDcl(any,4)
   {
   register word i, j;
   long l1, l2;
   int *cs, csbuf[CsetSize];
   char sbuf[MaxCvtLen];

   /*
    * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults to &pos
    * if Arg2 defaulted, 1 otherwise.  Arg4 defaults to 0.
    */
   if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
      RunErr(104, &Arg1);
   switch (defstr(&Arg2, sbuf, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg3, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg3, &l1, (word)1) == Error) 
            RunErr(0, NULL);
      }
   if (defint(&Arg4, &l2, (word)0) == Error) 
      RunErr(0, NULL);

   /*
    * Convert Arg3 and Arg4 to positions in Arg2. If Arg3 == Arg4 then the
    *  specified substring of Arg2 is empty and any fails. Otherwise make
    *  Arg3 the smaller of the two.  (Arg4 is of no further use.)
    */
   i = cvpos(l1, StrLen(Arg2));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg2));
   if (j == CvtFail)
      Fail;
   if (i == j)
      Fail;
   if (i > j)
      i = j;

   /*
    * If Arg2[Arg3] is not in the cset Arg1, fail.
    */
   j = (word)ToAscii(StrLoc(Arg2)[i-1]);
   if (!Testb(j, cs))
      Fail;

   /*
    * Return pos(s[i+1]).
    */
   Arg0.dword = D_Integer;
   IntVal(Arg0) = i + 1;
   Return;
   }


/*
 * bal(c1,c2,c3,s,i,j) - find end of a balanced substring of s[i:j].
 *  Generates successive positions.
 */

FncDcl(bal,6)
   {
   register word i, j;
   register int cnt, c;
   word t;
   long l1, l2;
   int *cs1, *cs2, *cs3;
   int csbuf1[CsetSize], csbuf2[CsetSize], csbuf3[CsetSize];
   char sbuf[MaxCvtLen];
   static int lpar[CsetSize] =	/* '(' */

#if EBCDIC != 1
      cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
#else					/* EBCDIC != 1 */
      cset_display(0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
#endif					/* EBCDIC != 1 */

   static int rpar[CsetSize] =	/* ')' */

#if EBCDIC != 1
      cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
#else					/* EBCDIC != 1 */
      cset_display(0, 0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
#endif					/* EBCDIC != 1 */

   /*
    *  Arg1 defaults to &cset; Arg2 defaults to '('; Arg3 defaults to
    *	')'; Arg4 to &subject; Arg5 to &pos if Arg4 defaulted, 1 otherwise;
    *	Arg6 defaults to 0.
    */
   if ((defcset(&Arg1, &cs1, csbuf1, k_cset.bits) == Error) ||
         (defcset(&Arg2, &cs2, csbuf2, lpar) == Error) ||
         (defcset(&Arg3, &cs3, csbuf3, rpar) == Error)) 
      RunErr(0, NULL);
   switch (defstr(&Arg4, sbuf, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg5, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg5, &l1, (word)1) == Error) 
         RunErr(0, NULL);
      }
   if (defint(&Arg6, &l2, (word)0) == Error) 
      RunErr(0, NULL);

   /*
    * Convert Arg5 and Arg6 to positions in Arg4 and order them.
    */
   i = cvpos(l1, StrLen(Arg4));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg4));
   if (j == CvtFail)
      Fail;
   if (i > j) {
      t = i;
      i = j;
      j = t;
      }

   /*
    * Loop through characters in Arg4[Arg5:Arg6].  When a character in Arg2 is
    *  found, increment cnt; when a character in Arg3 is found, decrement
    *  cnt.  When cnt is 0 there have been an equal number of occurrences
    *  of characters in Arg2 and Arg3, i.e., the string to the left of
    *  i is balanced.  If the string is balanced and the current character
    *  (Arg4[i]) is in Arg1, suspend with i.  Note that if cnt drops below
    *  zero, bal fails.
    */
   cnt = 0;
   Arg0.dword = D_Integer;
   while (i < j) {
      c = ToAscii(StrLoc(Arg4)[i-1]);
      if (cnt == 0 && Testb(c, cs1)) {
         IntVal(Arg0) = i;
         Suspend;
         }
      if (Testb(c, cs2))
         cnt++;
      else if (Testb(c, cs3))
         cnt--;
      if (cnt < 0)
         Fail;
      i++;
      }
   /*
    * Eventually fail.
    */
   Fail;
   }


/*
 * find(s1,s2,i,j) - find string s1 in s2[i:j] and return position in
 *  s2 of beginning of s1.
 * Generates successive positions.
 */

FncDcl(find,4)
   {
   register word l;
   register char *s1, *s2;
   word i, j, t;
   long l1, l2;
   char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];

   /*
    * Arg1 must be a string.  Arg2 defaults to &subject; Arg3 defaults
    *  to &pos if Arg2 is defaulted, or to 1 otherwise; Arg4 defaults
    *  to 0.

    */
   if (cvstr(&Arg1, sbuf1) == CvtFail) 
      RunErr(103, &Arg1);
   switch (defstr(&Arg2, sbuf2, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg3, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg3, &l1, (word)1) == Error) 
            RunErr(0, NULL);
      }
   if (defint(&Arg4, &l2, (word)0)== Error) 
      RunErr(0, NULL);

   /*
    * Convert Arg3 and Arg4 to absolute positions in Arg2 and order them.
    */
   i = cvpos(l1, StrLen(Arg2));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg2));
   if (j == CvtFail)
      Fail;
   if (i > j) {
      t = i;
      i = j;
      j = t;
      }

   /*
    * Loop through Arg2[i:j] trying to find Arg1 at each point, stopping
    *  when the remaining portion Arg2[i:j] is too short to contain Arg1.
    */
   Arg0.dword = D_Integer;
   while (i <= j - StrLen(Arg1)) {
      s1 = StrLoc(Arg1);
      s2 = StrLoc(Arg2) + i - 1;
      l = StrLen(Arg1);

      /*
       * Compare strings on a byte-wise basis; if the end is reached
       *  before inequality is found, suspend with the position of the
       *  string.
       */
      do {
         if (l-- <= 0) {
            IntVal(Arg0) = i;
            Suspend;
            break;
            }
         } while (*s1++ == *s2++);
      i++;
      }

   Fail;
   }

/*
 * many(c,s,i,j) - find longest prefix of s[i:j] of characters in c.
 */

FncDcl(many,4)
   {
   register word i, j, t;
   int *cs, csbuf[CsetSize];
   long l1, l2;
   char sbuf[MaxCvtLen];

   /*
    * Arg1 must be a cset.  Arg2 defaults to &subject;	Arg3 defaults to
    *  &pos if Arg2 defaulted, 1 otherwise;  Arg4 defaults to 0.
    */
   if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
      RunErr(104, &Arg1);
   switch (defstr(&Arg2, sbuf, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg3, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg3, &l1, (word)1) == Error) 
            RunErr(0, NULL);
      }
   if (defint(&Arg4, &l2, (word)0) == Error) 
      RunErr(0, NULL);

   /*
    * Convert Arg3 and Arg4 to absolute positions and order them.
    */
   i = cvpos(l1, StrLen(Arg2));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg2));
   if (j == CvtFail)
      Fail;
   if (i == j)
      Fail;
   if (i > j) {
      t = i;
      i = j;
      j = t;
      }

   /*
    * Fail if first character of Arg2[i:j] is not in Arg1.
    */
   t = (word)ToAscii(StrLoc(Arg2)[i-1]);
   if (!Testb(t, cs))
      Fail;

   /*
    * Move i along Arg2[i:j] until a character that is not in Arg1 is found or
    *  the end of the string is reached.
    */
   i++;
   while (i < j) {
      t = (word)ToAscii(StrLoc(Arg2)[i-1]);
      if (!Testb(t, cs))
         break;
      i++;
      }

   /*
    * Return the position of the first character not in Arg1.
    */
   Arg0.dword = D_Integer;
   IntVal(Arg0) = i;
   Return;
   }

/*
 * match(s1,s2,i,j) - test if s1 is prefix of s2[i:j].
 */
FncDcl(match,4)
   {
   register word i;
   register char *s1, *s2;
   word j, t;
   long l1, l2;
   char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];

   /*
    * Arg1 must be a string.  Arg2 defaults to &subject;  Arg3 defaults
    *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
    */
   if (cvstr(&Arg1, sbuf1) == CvtFail) 
      RunErr(103, &Arg1);
   switch (defstr(&Arg2, sbuf2, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg3, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg3, &l1, (word)1) == Error) 
            RunErr(0, NULL);
      }
   if (defint(&Arg4, &l2, (word)0) == Error) 
      RunErr(0, NULL);

   /*
    * Convert Arg3 and Arg4 to absolute positions and order them.
    */
   i = cvpos(l1, StrLen(Arg2));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg2));
   if (j == CvtFail)
      Fail;
   if (i > j) {
      t = i;
      i = j;
      j = t - j;
      }
   else
      j = j - i;

   /*
    * Cannot match unless Arg1 is as long as Arg2[i:j].
    */
   if (j < StrLen(Arg1))
      Fail;

   /*
    * Compare Arg1 with Arg2[i:j] for *Arg1 characters; fail if an inequality
    *  if found.
    */
   s1 = StrLoc(Arg1);
   s2 = StrLoc(Arg2) + i - 1;
   for (j = StrLen(Arg1); j > 0; j--)
      if (*s1++ != *s2++)
         Fail;

   /*
    * Return position of end of matched string in Arg2.
    */
   Arg0.dword = D_Integer;
   IntVal(Arg0) = i + StrLen(Arg1);
   Return;
   }

/*
 * upto(c,s,i,j) - find each occurrence in s[i:j] of a character in c.
 * Generates successive positions.
 */

FncDcl(upto,4)
   {
   register word i, j, t;
   long l1, l2;
   int *cs, csbuf[CsetSize];
   char sbuf[MaxCvtLen];

   /*
    * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults
    *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
    */
   if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
      RunErr(104, &Arg1);
   switch (defstr(&Arg2, sbuf, &k_subject)) {
      case Error:
         RunErr(0, NULL);
      case Defaulted:
         if (defint(&Arg3, &l1, k_pos) == Error) 
            RunErr(0, NULL);
         break;
      default:
         if (defint(&Arg3, &l1, (word)1) == Error) 
            RunErr(0, NULL);
      }
   if (defint(&Arg4, &l2, (word)0) == Error)
      RunErr(0, NULL);

   /*
    * Convert Arg3 and Arg4 to positions in Arg2 and order them.
    */
   i = cvpos(l1, StrLen(Arg2));
   if (i == CvtFail)
      Fail;
   j = cvpos(l2, StrLen(Arg2));
   if (j == CvtFail)
      Fail;
   if (i > j) {
      t = i;
      i = j;
      j = t;
      }

   /*
    * Look through Arg2[i:j] and suspend position of each occurrence of
    *  of a character in Arg1.
    */
   while (i < j) {
      t = (word)ToAscii(StrLoc(Arg2)[i-1]);
      if (Testb(t, cs)) {
         Arg0.dword = D_Integer;
         IntVal(Arg0) = i;
         Suspend;
         }
      i++;
      }
   /*
    * Eventually fail.
    */
   Fail;
   }