home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fscan.r < prev    next >
Text File  |  1996-03-22  |  3KB  |  151 lines
  1. /*
  2.  * File: fscan.r
  3.  *  Contents: move, pos, tab.
  4.  */
  5.  
  6. "move(i) - move &pos by i, return substring of &subject spanned."
  7. " Reverses effects if resumed."
  8.  
  9. function{0,1+} move(i)
  10.  
  11.    if !cnv:C_integer(i) then
  12.       runerr(101,i)
  13.  
  14.    abstract {
  15.       return string
  16.       }
  17.  
  18.    body {
  19.       register C_integer j;
  20.       C_integer oldpos;
  21.       long l;
  22.  
  23.       /*
  24.        * Save old &pos.  Local variable j holds &pos before the move.
  25.        */
  26.       oldpos = j = k_pos;
  27.  
  28.       /*
  29.        * If attempted move is past either end of the string, fail.
  30.        */
  31.       if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
  32.          fail;
  33.  
  34.       /*
  35.        * Set new &pos.
  36.        */
  37.       k_pos += i;
  38.       EVVal(k_pos, E_Spos);
  39.  
  40.       /*
  41.        * Make sure i >= 0.
  42.        */
  43.       if (i < 0) {
  44.          j += i;
  45.          i = -i;
  46.          }
  47.  
  48.       /*
  49.        * Suspend substring of &subject that was moved over.
  50.        */
  51.       suspend string(i, StrLoc(k_subject) + j - 1);
  52.  
  53.       /*
  54.        * If move is resumed, restore the old position and fail.
  55.        */
  56.       if (oldpos > StrLen(k_subject) + 1)
  57.          runerr(205, kywd_pos);
  58.       else {
  59.          k_pos = oldpos;
  60.          EVVal(k_pos, E_Spos);
  61.          }
  62.  
  63.       fail;
  64.       }
  65. end
  66.  
  67.  
  68. "pos(i) - test if &pos is at position i in &subject."
  69.  
  70. function{0,1} pos(i)
  71.  
  72.    if !cnv:C_integer(i) then
  73.       runerr(101, i)
  74.  
  75.    abstract {
  76.       return integer
  77.       }
  78.    body {
  79.       /*
  80.        * Fail if &pos is not equivalent to i, return i otherwise.
  81.        */
  82.       if ((i = cvpos(i, StrLen(k_subject))) != k_pos)
  83.          fail;
  84.       return C_integer i;
  85.       }
  86. end
  87.  
  88.  
  89. "tab(i) - set &pos to i, return substring of &subject spanned."
  90. "Reverses effects if resumed."
  91.  
  92. function{0,1+} tab(i)
  93.  
  94.    if !cnv:C_integer(i) then
  95.       runerr(101, i);
  96.  
  97.    abstract {
  98.       return string
  99.       }
  100.  
  101.    body {
  102.       C_integer j, t, oldpos;
  103.  
  104.       /*
  105.        * Convert i to an absolute position.
  106.        */
  107.       i = cvpos(i, StrLen(k_subject));
  108.       if (i == CvtFail)
  109.          fail;
  110.  
  111.       /*
  112.        * Save old &pos.  Local variable j holds &pos before the tab.
  113.        */
  114.       oldpos = j = k_pos;
  115.  
  116.       /*
  117.        * Set new &pos.
  118.        */
  119.       k_pos = i;
  120.       EVVal(k_pos, E_Spos);
  121.  
  122.       /*
  123.        *  Make i the length of the substring &subject[i:j]
  124.        */
  125.       if (j > i) {
  126.          t = j;
  127.          j = i;
  128.          i = t - j;
  129.          }
  130.       else
  131.          i = i - j;
  132.  
  133.       /*
  134.        * Suspend the portion of &subject that was tabbed over.
  135.        */
  136.       suspend string(i, StrLoc(k_subject) + j - 1);
  137.  
  138.       /*
  139.        * If tab is resumed, restore the old position and fail.
  140.        */
  141.       if (oldpos > StrLen(k_subject) + 1)
  142.          runerr(205, kywd_pos);
  143.       else {
  144.          k_pos = oldpos;
  145.          EVVal(k_pos, E_Spos);
  146.          }
  147.  
  148.       fail;
  149.       }
  150. end
  151.