home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fstranl < prev    next >
Encoding:
Text File  |  1990-07-19  |  10.7 KB  |  465 lines
  1. /*
  2.  * File: fstranl.c
  3.  *  Contents: any, bal, find, many, match, upto
  4.  */
  5.  
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9.  
  10.  
  11. /*
  12.  * any(c,s,i,j) - test if first character of s[i:j] is in c.
  13.  */
  14.  
  15. FncDcl(any,4)
  16.    {
  17.    register word i, j;
  18.    long l1, l2;
  19.    int *cs, csbuf[CsetSize];
  20.    char sbuf[MaxCvtLen];
  21.  
  22.    /*
  23.     * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults to &pos
  24.     * if Arg2 defaulted, 1 otherwise.  Arg4 defaults to 0.
  25.     */
  26.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  27.       RunErr(104, &Arg1);
  28.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  29.       case Error:
  30.          RunErr(0, NULL);
  31.       case Defaulted:
  32.          if (defint(&Arg3, &l1, k_pos) == Error) 
  33.             RunErr(0, NULL);
  34.          break;
  35.       default:
  36.          if (defint(&Arg3, &l1, (word)1) == Error) 
  37.             RunErr(0, NULL);
  38.       }
  39.    if (defint(&Arg4, &l2, (word)0) == Error) 
  40.       RunErr(0, NULL);
  41.  
  42.    /*
  43.     * Convert Arg3 and Arg4 to positions in Arg2. If Arg3 == Arg4 then the
  44.     *  specified substring of Arg2 is empty and any fails. Otherwise make
  45.     *  Arg3 the smaller of the two.  (Arg4 is of no further use.)
  46.     */
  47.    i = cvpos(l1, StrLen(Arg2));
  48.    if (i == CvtFail)
  49.       Fail;
  50.    j = cvpos(l2, StrLen(Arg2));
  51.    if (j == CvtFail)
  52.       Fail;
  53.    if (i == j)
  54.       Fail;
  55.    if (i > j)
  56.       i = j;
  57.  
  58.    /*
  59.     * If Arg2[Arg3] is not in the cset Arg1, fail.
  60.     */
  61.    j = (word)ToAscii(StrLoc(Arg2)[i-1]);
  62.    if (!Testb(j, cs))
  63.       Fail;
  64.  
  65.    /*
  66.     * Return pos(s[i+1]).
  67.     */
  68.    Arg0.dword = D_Integer;
  69.    IntVal(Arg0) = i + 1;
  70.    Return;
  71.    }
  72.  
  73.  
  74. /*
  75.  * bal(c1,c2,c3,s,i,j) - find end of a balanced substring of s[i:j].
  76.  *  Generates successive positions.
  77.  */
  78.  
  79. FncDcl(bal,6)
  80.    {
  81.    register word i, j;
  82.    register int cnt, c;
  83.    word t;
  84.    long l1, l2;
  85.    int *cs1, *cs2, *cs3;
  86.    int csbuf1[CsetSize], csbuf2[CsetSize], csbuf3[CsetSize];
  87.    char sbuf[MaxCvtLen];
  88.    static int lpar[CsetSize] =    /* '(' */
  89.  
  90. #if EBCDIC != 1
  91.       cset_display(0, 0, 0400, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  92. #else                    /* EBCDIC != 1 */
  93.       cset_display(0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  94. #endif                    /* EBCDIC != 1 */
  95.  
  96.    static int rpar[CsetSize] =    /* ')' */
  97.  
  98. #if EBCDIC != 1
  99.       cset_display(0, 0, 01000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  100. #else                    /* EBCDIC != 1 */
  101.       cset_display(0, 0, 0, 0, 0, 0x2000, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  102. #endif                    /* EBCDIC != 1 */
  103.  
  104.    /*
  105.     *  Arg1 defaults to &cset; Arg2 defaults to '('; Arg3 defaults to
  106.     *    ')'; Arg4 to &subject; Arg5 to &pos if Arg4 defaulted, 1 otherwise;
  107.     *    Arg6 defaults to 0.
  108.     */
  109.    if ((defcset(&Arg1, &cs1, csbuf1, k_cset.bits) == Error) ||
  110.          (defcset(&Arg2, &cs2, csbuf2, lpar) == Error) ||
  111.          (defcset(&Arg3, &cs3, csbuf3, rpar) == Error)) 
  112.       RunErr(0, NULL);
  113.    switch (defstr(&Arg4, sbuf, &k_subject)) {
  114.       case Error:
  115.          RunErr(0, NULL);
  116.       case Defaulted:
  117.          if (defint(&Arg5, &l1, k_pos) == Error) 
  118.             RunErr(0, NULL);
  119.          break;
  120.       default:
  121.          if (defint(&Arg5, &l1, (word)1) == Error) 
  122.          RunErr(0, NULL);
  123.       }
  124.    if (defint(&Arg6, &l2, (word)0) == Error) 
  125.       RunErr(0, NULL);
  126.  
  127.    /*
  128.     * Convert Arg5 and Arg6 to positions in Arg4 and order them.
  129.     */
  130.    i = cvpos(l1, StrLen(Arg4));
  131.    if (i == CvtFail)
  132.       Fail;
  133.    j = cvpos(l2, StrLen(Arg4));
  134.    if (j == CvtFail)
  135.       Fail;
  136.    if (i > j) {
  137.       t = i;
  138.       i = j;
  139.       j = t;
  140.       }
  141.  
  142.    /*
  143.     * Loop through characters in Arg4[Arg5:Arg6].  When a character in Arg2 is
  144.     *  found, increment cnt; when a character in Arg3 is found, decrement
  145.     *  cnt.  When cnt is 0 there have been an equal number of occurrences
  146.     *  of characters in Arg2 and Arg3, i.e., the string to the left of
  147.     *  i is balanced.  If the string is balanced and the current character
  148.     *  (Arg4[i]) is in Arg1, suspend with i.  Note that if cnt drops below
  149.     *  zero, bal fails.
  150.     */
  151.    cnt = 0;
  152.    Arg0.dword = D_Integer;
  153.    while (i < j) {
  154.       c = ToAscii(StrLoc(Arg4)[i-1]);
  155.       if (cnt == 0 && Testb(c, cs1)) {
  156.          IntVal(Arg0) = i;
  157.          Suspend;
  158.          }
  159.       if (Testb(c, cs2))
  160.          cnt++;
  161.       else if (Testb(c, cs3))
  162.          cnt--;
  163.       if (cnt < 0)
  164.          Fail;
  165.       i++;
  166.       }
  167.    /*
  168.     * Eventually fail.
  169.     */
  170.    Fail;
  171.    }
  172.  
  173.  
  174. /*
  175.  * find(s1,s2,i,j) - find string s1 in s2[i:j] and return position in
  176.  *  s2 of beginning of s1.
  177.  * Generates successive positions.
  178.  */
  179.  
  180. FncDcl(find,4)
  181.    {
  182.    register word l;
  183.    register char *s1, *s2;
  184.    word i, j, t;
  185.    long l1, l2;
  186.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  187.  
  188.    /*
  189.     * Arg1 must be a string.  Arg2 defaults to &subject; Arg3 defaults
  190.     *  to &pos if Arg2 is defaulted, or to 1 otherwise; Arg4 defaults
  191.     *  to 0.
  192.  
  193.     */
  194.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  195.       RunErr(103, &Arg1);
  196.    switch (defstr(&Arg2, sbuf2, &k_subject)) {
  197.       case Error:
  198.          RunErr(0, NULL);
  199.       case Defaulted:
  200.          if (defint(&Arg3, &l1, k_pos) == Error) 
  201.             RunErr(0, NULL);
  202.          break;
  203.       default:
  204.          if (defint(&Arg3, &l1, (word)1) == Error) 
  205.             RunErr(0, NULL);
  206.       }
  207.    if (defint(&Arg4, &l2, (word)0)== Error) 
  208.       RunErr(0, NULL);
  209.  
  210.    /*
  211.     * Convert Arg3 and Arg4 to absolute positions in Arg2 and order them.
  212.     */
  213.    i = cvpos(l1, StrLen(Arg2));
  214.    if (i == CvtFail)
  215.       Fail;
  216.    j = cvpos(l2, StrLen(Arg2));
  217.    if (j == CvtFail)
  218.       Fail;
  219.    if (i > j) {
  220.       t = i;
  221.       i = j;
  222.       j = t;
  223.       }
  224.  
  225.    /*
  226.     * Loop through Arg2[i:j] trying to find Arg1 at each point, stopping
  227.     *  when the remaining portion Arg2[i:j] is too short to contain Arg1.
  228.     */
  229.    Arg0.dword = D_Integer;
  230.    while (i <= j - StrLen(Arg1)) {
  231.       s1 = StrLoc(Arg1);
  232.       s2 = StrLoc(Arg2) + i - 1;
  233.       l = StrLen(Arg1);
  234.  
  235.       /*
  236.        * Compare strings on a byte-wise basis; if the end is reached
  237.        *  before inequality is found, suspend with the position of the
  238.        *  string.
  239.        */
  240.       do {
  241.          if (l-- <= 0) {
  242.             IntVal(Arg0) = i;
  243.             Suspend;
  244.             break;
  245.             }
  246.          } while (*s1++ == *s2++);
  247.       i++;
  248.       }
  249.  
  250.    Fail;
  251.    }
  252.  
  253. /*
  254.  * many(c,s,i,j) - find longest prefix of s[i:j] of characters in c.
  255.  */
  256.  
  257. FncDcl(many,4)
  258.    {
  259.    register word i, j, t;
  260.    int *cs, csbuf[CsetSize];
  261.    long l1, l2;
  262.    char sbuf[MaxCvtLen];
  263.  
  264.    /*
  265.     * Arg1 must be a cset.  Arg2 defaults to &subject;    Arg3 defaults to
  266.     *  &pos if Arg2 defaulted, 1 otherwise;  Arg4 defaults to 0.
  267.     */
  268.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  269.       RunErr(104, &Arg1);
  270.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  271.       case Error:
  272.          RunErr(0, NULL);
  273.       case Defaulted:
  274.          if (defint(&Arg3, &l1, k_pos) == Error) 
  275.             RunErr(0, NULL);
  276.          break;
  277.       default:
  278.          if (defint(&Arg3, &l1, (word)1) == Error) 
  279.             RunErr(0, NULL);
  280.       }
  281.    if (defint(&Arg4, &l2, (word)0) == Error) 
  282.       RunErr(0, NULL);
  283.  
  284.    /*
  285.     * Convert Arg3 and Arg4 to absolute positions and order them.
  286.     */
  287.    i = cvpos(l1, StrLen(Arg2));
  288.    if (i == CvtFail)
  289.       Fail;
  290.    j = cvpos(l2, StrLen(Arg2));
  291.    if (j == CvtFail)
  292.       Fail;
  293.    if (i == j)
  294.       Fail;
  295.    if (i > j) {
  296.       t = i;
  297.       i = j;
  298.       j = t;
  299.       }
  300.  
  301.    /*
  302.     * Fail if first character of Arg2[i:j] is not in Arg1.
  303.     */
  304.    t = (word)ToAscii(StrLoc(Arg2)[i-1]);
  305.    if (!Testb(t, cs))
  306.       Fail;
  307.  
  308.    /*
  309.     * Move i along Arg2[i:j] until a character that is not in Arg1 is found or
  310.     *  the end of the string is reached.
  311.     */
  312.    i++;
  313.    while (i < j) {
  314.       t = (word)ToAscii(StrLoc(Arg2)[i-1]);
  315.       if (!Testb(t, cs))
  316.          break;
  317.       i++;
  318.       }
  319.  
  320.    /*
  321.     * Return the position of the first character not in Arg1.
  322.     */
  323.    Arg0.dword = D_Integer;
  324.    IntVal(Arg0) = i;
  325.    Return;
  326.    }
  327.  
  328. /*
  329.  * match(s1,s2,i,j) - test if s1 is prefix of s2[i:j].
  330.  */
  331. FncDcl(match,4)
  332.    {
  333.    register word i;
  334.    register char *s1, *s2;
  335.    word j, t;
  336.    long l1, l2;
  337.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  338.  
  339.    /*
  340.     * Arg1 must be a string.  Arg2 defaults to &subject;  Arg3 defaults
  341.     *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
  342.     */
  343.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  344.       RunErr(103, &Arg1);
  345.    switch (defstr(&Arg2, sbuf2, &k_subject)) {
  346.       case Error:
  347.          RunErr(0, NULL);
  348.       case Defaulted:
  349.          if (defint(&Arg3, &l1, k_pos) == Error) 
  350.             RunErr(0, NULL);
  351.          break;
  352.       default:
  353.          if (defint(&Arg3, &l1, (word)1) == Error) 
  354.             RunErr(0, NULL);
  355.       }
  356.    if (defint(&Arg4, &l2, (word)0) == Error) 
  357.       RunErr(0, NULL);
  358.  
  359.    /*
  360.     * Convert Arg3 and Arg4 to absolute positions and order them.
  361.     */
  362.    i = cvpos(l1, StrLen(Arg2));
  363.    if (i == CvtFail)
  364.       Fail;
  365.    j = cvpos(l2, StrLen(Arg2));
  366.    if (j == CvtFail)
  367.       Fail;
  368.    if (i > j) {
  369.       t = i;
  370.       i = j;
  371.       j = t - j;
  372.       }
  373.    else
  374.       j = j - i;
  375.  
  376.    /*
  377.     * Cannot match unless Arg1 is as long as Arg2[i:j].
  378.     */
  379.    if (j < StrLen(Arg1))
  380.       Fail;
  381.  
  382.    /*
  383.     * Compare Arg1 with Arg2[i:j] for *Arg1 characters; fail if an inequality
  384.     *  if found.
  385.     */
  386.    s1 = StrLoc(Arg1);
  387.    s2 = StrLoc(Arg2) + i - 1;
  388.    for (j = StrLen(Arg1); j > 0; j--)
  389.       if (*s1++ != *s2++)
  390.          Fail;
  391.  
  392.    /*
  393.     * Return position of end of matched string in Arg2.
  394.     */
  395.    Arg0.dword = D_Integer;
  396.    IntVal(Arg0) = i + StrLen(Arg1);
  397.    Return;
  398.    }
  399.  
  400. /*
  401.  * upto(c,s,i,j) - find each occurrence in s[i:j] of a character in c.
  402.  * Generates successive positions.
  403.  */
  404.  
  405. FncDcl(upto,4)
  406.    {
  407.    register word i, j, t;
  408.    long l1, l2;
  409.    int *cs, csbuf[CsetSize];
  410.    char sbuf[MaxCvtLen];
  411.  
  412.    /*
  413.     * Arg1 must be a cset.  Arg2 defaults to &subject; Arg3 defaults
  414.     *  to &pos if Arg2 defaulted, 1 otherwise; Arg4 defaults to 0.
  415.     */
  416.    if (cvcset(&Arg1, &cs, csbuf) == CvtFail) 
  417.       RunErr(104, &Arg1);
  418.    switch (defstr(&Arg2, sbuf, &k_subject)) {
  419.       case Error:
  420.          RunErr(0, NULL);
  421.       case Defaulted:
  422.          if (defint(&Arg3, &l1, k_pos) == Error) 
  423.             RunErr(0, NULL);
  424.          break;
  425.       default:
  426.          if (defint(&Arg3, &l1, (word)1) == Error) 
  427.             RunErr(0, NULL);
  428.       }
  429.    if (defint(&Arg4, &l2, (word)0) == Error)
  430.       RunErr(0, NULL);
  431.  
  432.    /*
  433.     * Convert Arg3 and Arg4 to positions in Arg2 and order them.
  434.     */
  435.    i = cvpos(l1, StrLen(Arg2));
  436.    if (i == CvtFail)
  437.       Fail;
  438.    j = cvpos(l2, StrLen(Arg2));
  439.    if (j == CvtFail)
  440.       Fail;
  441.    if (i > j) {
  442.       t = i;
  443.       i = j;
  444.       j = t;
  445.       }
  446.  
  447.    /*
  448.     * Look through Arg2[i:j] and suspend position of each occurrence of
  449.     *  of a character in Arg1.
  450.     */
  451.    while (i < j) {
  452.       t = (word)ToAscii(StrLoc(Arg2)[i-1]);
  453.       if (Testb(t, cs)) {
  454.          Arg0.dword = D_Integer;
  455.          IntVal(Arg0) = i;
  456.          Suspend;
  457.          }
  458.       i++;
  459.       }
  460.    /*
  461.     * Eventually fail.
  462.     */
  463.    Fail;
  464.    }
  465.