home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / m2posx14 / src / pstring.ipp < prev    next >
Encoding:
Modula Implementation  |  1994-04-25  |  15.3 KB  |  646 lines
  1. IMPLEMENTATION MODULE pSTRING;
  2. __IMP_SWITCHES__
  3. __DEBUG__
  4. #ifdef HM2
  5. #ifdef __LONG_WHOLE__
  6. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  7. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  8. #else
  9. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  10. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  11. #endif
  12. #endif
  13. (*****************************************************************************)
  14. (* 25-Apr-94, Holger Kleinschmidt                                            *)
  15. (*****************************************************************************)
  16.  
  17. VAL_INTRINSIC
  18. CAST_IMPORT
  19.  
  20. FROM PORTAB IMPORT
  21. (* CONST*) NULL, MAXCARD,
  22. (* TYPE *) UNSIGNEDWORD, SIGNEDWORD;
  23.  
  24. FROM types IMPORT
  25. (* CONST*) EOS;
  26.  
  27. FROM ctype IMPORT
  28. (* PROC *) tolower, toupper;
  29.  
  30. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  31.  
  32. CONST
  33.   NOTFOUND = -1;
  34.  
  35. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  36.  
  37. PROCEDURE SLEN ((* EIN/ -- *) REF s : ARRAY OF CHAR ): CARDINAL;
  38. (*T*)
  39. #if (defined ISOM2) || (defined MM2) || (defined HM2)
  40. BEGIN
  41.  RETURN(VAL(CARDINAL,LENGTH(s)));
  42. #else
  43. VAR __REG__ i : UNSIGNEDWORD;
  44. BEGIN
  45.  i := 0;
  46.  WHILE (i <= VAL(UNSIGNEDWORD,HIGH(s))) AND (s[i] <> EOS) DO
  47.    INC(i);
  48.  END;
  49.  RETURN(VAL(CARDINAL,i));
  50. #endif
  51. END SLEN;
  52.  
  53. (*---------------------------------------------------------------------------*)
  54.  
  55. PROCEDURE ASSIGN ((* EIN/ -- *) REF src : ARRAY OF CHAR;
  56.                   (* -- /AUS *) VAR dst : ARRAY OF CHAR );
  57. (*T*)
  58. VAR __REG__ i   : UNSIGNEDWORD;
  59.     __REG__ max : UNSIGNEDWORD;
  60.  
  61. BEGIN
  62.  IF HIGH(src) > HIGH(dst) THEN
  63.    max := VAL(UNSIGNEDWORD,HIGH(dst));
  64.  ELSE
  65.    max := VAL(UNSIGNEDWORD,HIGH(src));
  66.  END;
  67.  
  68.  i := 0;
  69.  WHILE (i <= max) AND (src[i] <> EOS) DO
  70.    dst[i] := src[i];
  71.    INC(i);
  72.  END;
  73.  IF i <= VAL(UNSIGNEDWORD,HIGH(dst)) THEN
  74.    dst[i] := EOS;
  75.  END;
  76. END ASSIGN;
  77.  
  78. (*---------------------------------------------------------------------------*)
  79.  
  80. PROCEDURE CONCAT ((* EIN/ -- *) REF s1  : ARRAY OF CHAR;
  81.                   (* EIN/ -- *)     s2  : ARRAY OF CHAR;
  82.                   (* -- /AUS *) VAR dst : ARRAY OF CHAR );
  83. (*T*)
  84. VAR __REG__ i1  : SIGNEDWORD;
  85.     __REG__ i2  : SIGNEDWORD;
  86.     __REG__ max : SIGNEDWORD;
  87.  
  88. BEGIN
  89.  IF HIGH(s1) > HIGH(dst) THEN
  90.    max := VAL(SIGNEDWORD,HIGH(dst));
  91.  ELSE
  92.    max := VAL(SIGNEDWORD,HIGH(s1));
  93.  END;
  94.  
  95.  i1 := 0;
  96.  WHILE (i1 <= max) AND (s1[i1] <> EOS) DO
  97.    dst[i1] := s1[i1];
  98.    INC(i1);
  99.  END;
  100.  
  101.  IF VAL(SIGNEDWORD,HIGH(s2)) > (VAL(SIGNEDWORD,HIGH(dst)) - i1) THEN
  102.    max := VAL(SIGNEDWORD,HIGH(dst)) - i1;
  103.  ELSE
  104.    max := VAL(SIGNEDWORD,HIGH(s2));
  105.  END;
  106.  
  107.  i2 := 0;
  108.  WHILE (i2 <= max) AND (s2[i2] <> EOS) DO
  109.    dst[i1] := s2[i2];
  110.    INC(i1);
  111.    INC(i2);
  112.  END;
  113.  
  114.  IF i1 <= VAL(SIGNEDWORD,HIGH(dst)) THEN
  115.    dst[i1] := EOS;
  116.  END;
  117. END CONCAT;
  118.  
  119. (*---------------------------------------------------------------------------*)
  120.  
  121. PROCEDURE iappend (    len : CARDINAL;
  122.                    VAR app : ARRAY OF CHAR;
  123.                    VAR dst : ARRAY OF CHAR );
  124.  
  125. VAR __REG__ dIdx : UNSIGNEDWORD;
  126.     __REG__ aIdx : UNSIGNEDWORD;
  127.     __REG__ max  : UNSIGNEDWORD;
  128.  
  129. BEGIN
  130.  dIdx := VAL(UNSIGNEDWORD,SLEN(dst));
  131.  max  := VAL(UNSIGNEDWORD,HIGH(dst) + 1) - dIdx;
  132.  IF VAL(CARDINAL,max) > len THEN
  133.    max := VAL(UNSIGNEDWORD,len);
  134.  END;
  135.  IF max > VAL(UNSIGNEDWORD,HIGH(app)) THEN
  136.    max := VAL(UNSIGNEDWORD,HIGH(app) + 1);
  137.  END;
  138.  
  139.  aIdx := 0;
  140.  WHILE (aIdx < max) AND (app[aIdx] <> EOS) DO
  141.    dst[dIdx] := app[aIdx];
  142.    INC(aIdx);
  143.    INC(dIdx);
  144.  END;
  145.  
  146.  IF dIdx <= VAL(UNSIGNEDWORD,HIGH(dst)) THEN
  147.    dst[dIdx] := EOS;
  148.  END;
  149. END iappend;
  150.  
  151. (*---------------------------------------------------------------------------*)
  152.  
  153. PROCEDURE APPEND ((* EIN/ -- *) REF app : ARRAY OF CHAR;
  154.                   (* EIN/AUS *) VAR dst : ARRAY OF CHAR );
  155. (*T*)
  156. BEGIN
  157.  iappend(MAXCARD, app, dst);
  158. END APPEND;
  159.  
  160. (*---------------------------------------------------------------------------*)
  161.  
  162. PROCEDURE APPENDN ((* EIN/ -- *)     len : CARDINAL;
  163.                    (* EIN/ -- *) REF app : ARRAY OF CHAR;
  164.                    (* EIN/AUS *) VAR dst : ARRAY OF CHAR );
  165. (*T*)
  166. BEGIN
  167.  iappend(len, app, dst);
  168. END APPENDN;
  169.  
  170. (*---------------------------------------------------------------------------*)
  171.  
  172. PROCEDURE APPENDCHR ((* EIN/ -- *)     c   : CHAR;
  173.                      (* EIN/AUS *) VAR dst : ARRAY OF CHAR );
  174. (*T*)
  175. VAR __REG__ dIdx : UNSIGNEDWORD;
  176.  
  177. BEGIN
  178.  dIdx := VAL(UNSIGNEDWORD,SLEN(dst));
  179.  IF dIdx <= VAL(UNSIGNEDWORD,HIGH(dst)) THEN
  180.    dst[dIdx] := c;
  181.    IF dIdx < VAL(UNSIGNEDWORD,HIGH(dst)) THEN
  182.      dst[dIdx+1] := EOS;
  183.    END;
  184.  END;
  185. END APPENDCHR;
  186.  
  187. (*---------------------------------------------------------------------------*)
  188.  
  189. PROCEDURE COPY ((* EIN/ -- *)     from : CARDINAL;
  190.                 (* EIN/ -- *)     len  : CARDINAL;
  191.                 (* EIN/ -- *) REF src  : ARRAY OF CHAR;
  192.                 (* -- /AUS *) VAR dst  : ARRAY OF CHAR );
  193. (*T*)
  194. VAR          srcLen : CARDINAL;
  195.              cnt    : CARDINAL;
  196.      __REG__ sIdx   : UNSIGNEDWORD;
  197.      __REG__ dIdx   : SIGNEDWORD;
  198.      __REG__ max    : SIGNEDWORD;
  199.  
  200. BEGIN
  201.  srcLen := SLEN(src);
  202.  
  203.  IF (len > MAXCARD - from) OR (from + len > srcLen) THEN
  204.    IF from < srcLen THEN
  205.      cnt := srcLen - from;
  206.    ELSE
  207.      cnt := 0;
  208.    END;
  209.  ELSE
  210.    cnt := len;
  211.  END;
  212.  
  213.  IF cnt > VAL(CARDINAL,HIGH(dst)) THEN
  214.    max := VAL(SIGNEDWORD,HIGH(dst));
  215.  ELSE
  216.    max := VAL(SIGNEDWORD,cnt) - 1;
  217.  END;
  218.  
  219.  dIdx := 0;
  220.  sIdx := VAL(UNSIGNEDWORD,from);
  221.  WHILE dIdx <= max DO
  222.    dst[dIdx] := src[sIdx];
  223.    INC(dIdx);
  224.    INC(sIdx);
  225.  END;
  226.  
  227.  IF dIdx <= VAL(SIGNEDWORD,HIGH(dst)) THEN
  228.    dst[dIdx] := EOS;
  229.  END;
  230. END COPY;
  231.  
  232. (*---------------------------------------------------------------------------*)
  233.  
  234. PROCEDURE INSERT ((* EIN/ -- *)     at  : CARDINAL;
  235.                   (* EIN/ -- *)     ins : ARRAY OF CHAR;
  236.                   (* EIN/AUS *) VAR s   : ARRAY OF CHAR );
  237. (*T*)
  238. VAR         spc  : SIGNEDWORD;
  239.     __REG__ sLen : SIGNEDWORD;
  240.     __REG__ iLen : SIGNEDWORD;
  241.     __REG__ i    : SIGNEDWORD;
  242.  
  243. BEGIN
  244.  sLen := VAL(SIGNEDWORD,SLEN(s));
  245.  iLen := VAL(SIGNEDWORD,SLEN(ins));
  246.  
  247.  IF at > VAL(CARDINAL,sLen) THEN
  248.    at := VAL(CARDINAL,sLen);
  249.  END;
  250.  
  251.  spc := (VAL(SIGNEDWORD,HIGH(s) + 1) - sLen) - iLen;
  252.  
  253.  IF spc < 0 THEN
  254.    INC(sLen, spc);
  255.    IF VAL(SIGNEDWORD,HIGH(s) + 1) - VAL(SIGNEDWORD,at) < iLen THEN
  256.      iLen := VAL(SIGNEDWORD,HIGH(s) + 1) - VAL(SIGNEDWORD,at);
  257.    END;
  258.  ELSIF spc > 0 THEN
  259.    s[sLen+iLen] := EOS;
  260.  END;
  261.  
  262.  FOR i := sLen - 1 TO VAL(SIGNEDWORD,at) BY -1 DO
  263.    s[i+iLen] := s[i];
  264.  END;
  265.  
  266.  FOR i := 0 TO iLen - 1 DO
  267.    s[VAL(SIGNEDWORD,at)+i] := ins[i];
  268.  END;
  269. END INSERT;
  270.  
  271. (*---------------------------------------------------------------------------*)
  272.  
  273. PROCEDURE DELETE ((* EIN/ -- *)     from : CARDINAL;
  274.                   (* EIN/ -- *)     len  : CARDINAL;
  275.                   (* EIN/AUS *) VAR s    : ARRAY OF CHAR );
  276. (*T*)
  277. VAR __REG__ strLen : CARDINAL;
  278.  
  279. BEGIN
  280.  strLen := SLEN(s);
  281.  
  282.  IF from < MAXCARD - len THEN
  283.    INC(len, from);
  284.  ELSE
  285.    len := MAXCARD;
  286.  END;
  287.  
  288.  WHILE len < strLen DO
  289.    s[VAL(UNSIGNEDWORD,from)] := s[VAL(UNSIGNEDWORD,len)];
  290.    INC(from);
  291.    INC(len);
  292.  END;
  293.  
  294.  IF from <= VAL(CARDINAL,HIGH(s)) THEN
  295.    s[VAL(UNSIGNEDWORD,from)] := EOS;
  296.  END;
  297. END DELETE;
  298.  
  299. (*---------------------------------------------------------------------------*)
  300.  
  301. PROCEDURE LOWER ((* EIN/AUS *) VAR s : ARRAY OF CHAR );
  302. (*T*)
  303. VAR __REG__ i : UNSIGNEDWORD;
  304.  
  305. BEGIN
  306.  i := 0;
  307.  WHILE (i <= VAL(UNSIGNEDWORD,HIGH(s))) AND (s[i] <> EOS) DO
  308.    s[i] := tolower(s[i]);
  309.    INC(i);
  310.  END;
  311. END LOWER;
  312.  
  313. (*---------------------------------------------------------------------------*)
  314.  
  315. PROCEDURE UPPER ((* EIN/AUS *) VAR s : ARRAY OF CHAR );
  316. (*T*)
  317. VAR __REG__ i : UNSIGNEDWORD;
  318.  
  319. BEGIN
  320.  i := 0;
  321.  WHILE (i <= VAL(UNSIGNEDWORD,HIGH(s))) AND (s[i] <> EOS) DO
  322.    s[i] := toupper(s[i]);
  323.    INC(i);
  324.  END;
  325. END UPPER;
  326.  
  327. (*---------------------------------------------------------------------------*)
  328.  
  329. PROCEDURE compare (    len : CARDINAL;
  330.                    VAR s1  : ARRAY OF CHAR;
  331.                    VAR s2  : ARRAY OF CHAR ): INTEGER;
  332.  
  333. CONST less    = -1;
  334.       equal   =  0;
  335.       greater =  1;
  336.  
  337. VAR __REG__ i   : UNSIGNEDWORD;
  338.     __REG__ ch  : CHAR;
  339.     __REG__ max : UNSIGNEDWORD;
  340.  
  341. BEGIN
  342.  IF len = 0 THEN
  343.    RETURN(equal);
  344.  ELSE
  345.    DEC(len);
  346.  END;
  347.  IF HIGH(s1) > HIGH(s2) THEN
  348.    max := VAL(UNSIGNEDWORD,HIGH(s2));
  349.  ELSE
  350.    max := VAL(UNSIGNEDWORD,HIGH(s1));
  351.  END;
  352.  IF VAL(CARDINAL,max) > len THEN
  353.    max := VAL(UNSIGNEDWORD,len);
  354.  END;
  355.  
  356.  i := 0;
  357.  REPEAT
  358.    ch := s1[i];
  359.    IF ch <> s2[i]  THEN
  360.      IF ch < s2[i]  THEN
  361.        RETURN(less);
  362.      ELSE
  363.        RETURN(greater);
  364.      END;
  365.    ELSIF ch = EOS THEN
  366.      RETURN(equal);
  367.    END;
  368.  
  369.    INC(i);
  370.  UNTIL i > max;
  371.  
  372. (* Bis hierher waren die beiden Strings gleich *)
  373.  
  374.  IF max = VAL(UNSIGNEDWORD,len) THEN
  375.    RETURN(equal);
  376.  ELSIF HIGH(s1) < HIGH(s2) THEN
  377.    (* i <= HIGH(s2) *)
  378.    IF s2[i] = EOS THEN
  379.      RETURN(equal);
  380.    ELSE
  381.      RETURN(less);
  382.    END;
  383.  ELSIF HIGH(s1) > HIGH(s2) THEN
  384.    (* i <= HIGH(s1) *)
  385.    IF s1[i] = EOS  THEN
  386.      RETURN(equal);
  387.    ELSE
  388.      RETURN(greater);
  389.    END;
  390.  ELSE (* HIGH(s1) = HIGH(s2) *)
  391.    RETURN(equal);
  392.  END;
  393. END compare;
  394.  
  395. (*---------------------------------------------------------------------------*)
  396.  
  397. PROCEDURE EQUAL ((* EIN/ -- *) REF s1 : ARRAY OF CHAR;
  398.                  (* EIN/ -- *) REF s2 : ARRAY OF CHAR ): BOOLEAN;
  399. (*T*)
  400. BEGIN
  401.  RETURN(compare(MAXCARD, s1, s2) = 0);
  402. END EQUAL;
  403.  
  404. (*---------------------------------------------------------------------------*)
  405.  
  406. PROCEDURE EQUALN ((* EIN/ -- *)     len : CARDINAL;
  407.                   (* EIN/ -- *) REF s1  : ARRAY OF CHAR;
  408.                   (* EIN/ -- *) REF s2  : ARRAY OF CHAR ): BOOLEAN;
  409. (*T*)
  410. BEGIN
  411.  RETURN(compare(len, s1, s2) = 0);
  412. END EQUALN;
  413.  
  414. (*---------------------------------------------------------------------------*)
  415.  
  416. PROCEDURE COMPARE ((* EIN/ -- *) REF s1 : ARRAY OF CHAR;
  417.                    (* EIN/ -- *) REF s2 : ARRAY OF CHAR ): INTEGER;
  418. (*T*)
  419. BEGIN
  420.  RETURN(compare(MAXCARD, s1, s2));
  421. END COMPARE;
  422.  
  423. (*---------------------------------------------------------------------------*)
  424.  
  425. PROCEDURE COMPAREN ((* EIN/ -- *)     len : CARDINAL;
  426.                     (* EIN/ -- *) REF s1  : ARRAY OF CHAR;
  427.                     (* EIN/ -- *) REF s2  : ARRAY OF CHAR ): INTEGER;
  428. (*T*)
  429. BEGIN
  430.  RETURN(compare(len, s1, s2));
  431. END COMPAREN;
  432.  
  433. (*---------------------------------------------------------------------------*)
  434.  
  435. PROCEDURE LPOS ((* EIN/ -- *)     from : CARDINAL;
  436.                 (* EIN/ -- *) REF pat  : ARRAY OF CHAR;
  437.                 (* EIN/ -- *) REF s    : ARRAY OF CHAR ): INTEGER;
  438. (*T*)
  439. VAR         sLen  : CARDINAL;
  440.             tries : CARDINAL;
  441.     __REG__ pLen  : CARDINAL;
  442.     __REG__ pIdx  : UNSIGNEDWORD;
  443.     __REG__ start : UNSIGNEDWORD;
  444.  
  445. BEGIN
  446.  sLen := SLEN(s);
  447.  pLen := SLEN(pat);
  448.  
  449.  IF (pLen = 0) OR (pLen > sLen) OR (from > sLen - pLen) THEN
  450.    RETURN(NOTFOUND);
  451.  ELSE
  452.    tries := sLen - pLen - from;
  453.    start := VAL(UNSIGNEDWORD,from);
  454.  END;
  455.  
  456.  LOOP
  457.    pIdx := 0;
  458.    WHILE (pIdx < VAL(UNSIGNEDWORD,pLen)) AND (s[start] = pat[pIdx]) DO
  459.      INC(start);
  460.      INC(pIdx);
  461.    END;
  462.    DEC(start, pIdx);
  463.  
  464.    IF pIdx = VAL(UNSIGNEDWORD,pLen) THEN
  465.      RETURN(VAL(INTEGER,start));
  466.    ELSIF tries = 0 THEN
  467.      RETURN(NOTFOUND);
  468.    END;
  469.  
  470.    INC(start);
  471.    DEC(tries);
  472.  END;
  473. END LPOS;
  474.  
  475. (*---------------------------------------------------------------------------*)
  476.  
  477. PROCEDURE RPOS ((* EIN/ -- *)     from : CARDINAL;
  478.                 (* EIN/ -- *) REF pat  : ARRAY OF CHAR;
  479.                 (* EIN/ -- *) REF s    : ARRAY OF CHAR ): INTEGER;
  480. (*T*)
  481. VAR         sLen  : CARDINAL;
  482.     __REG__ pLen  : CARDINAL;
  483.     __REG__ pIdx  : UNSIGNEDWORD;
  484.     __REG__ start : UNSIGNEDWORD;
  485.  
  486. BEGIN
  487.  sLen  := SLEN(s);
  488.  pLen  := SLEN(pat);
  489.  
  490.  IF (pLen = 0) OR (pLen > sLen) THEN
  491.    RETURN(NOTFOUND);
  492.  END;
  493.  
  494.  IF from > sLen - pLen THEN
  495.    from := sLen - pLen;
  496.  END;
  497.  start := VAL(UNSIGNEDWORD,from);
  498.  
  499.  LOOP
  500.    pIdx := 0;
  501.    WHILE (pIdx < VAL(UNSIGNEDWORD,pLen)) AND (s[start] = pat[pIdx]) DO
  502.      INC(start);
  503.      INC(pIdx);
  504.    END;
  505.    DEC(start, pIdx);
  506.  
  507.    IF pIdx = VAL(UNSIGNEDWORD,pLen) THEN
  508.      RETURN(VAL(INTEGER,start));
  509.    ELSIF start = 0 THEN
  510.      RETURN(NOTFOUND);
  511.    END;
  512.  
  513.    DEC(start);
  514.  END;
  515. END RPOS;
  516.  
  517. (*---------------------------------------------------------------------------*)
  518.  
  519. PROCEDURE LPOSCHR ((* EIN/ -- *)     from : CARDINAL;
  520.                    (* EIN/ -- *)     c    : CHAR;
  521.                    (* EIN/ -- *) REF s    : ARRAY OF CHAR ): INTEGER;
  522. (*T*)
  523. VAR __REG__ len   : UNSIGNEDWORD;
  524.     __REG__ start : UNSIGNEDWORD;
  525.  
  526. BEGIN
  527.  len   := VAL(UNSIGNEDWORD,SLEN(s));
  528.  start := VAL(UNSIGNEDWORD,from);
  529.  
  530.  WHILE (start < len) AND (s[start] <> c) DO
  531.    INC(start);
  532.  END;
  533.  
  534.  IF start >= len THEN
  535.    RETURN(NOTFOUND);
  536.  ELSE
  537.    RETURN(VAL(INTEGER,start));
  538.  END;
  539. END LPOSCHR;
  540.  
  541. (*---------------------------------------------------------------------------*)
  542.  
  543. PROCEDURE RPOSCHR ((* EIN/ -- *)     from : CARDINAL;
  544.                    (* EIN/ -- *)     c    : CHAR;
  545.                    (* EIN/ -- *) REF s    : ARRAY OF CHAR ): INTEGER;
  546. (*T*)
  547. VAR         len   : CARDINAL;
  548.     __REG__ start : UNSIGNEDWORD;
  549.  
  550. BEGIN
  551.  len := SLEN(s);
  552.  
  553.  IF len = 0 THEN
  554.    RETURN(NOTFOUND);
  555.  ELSIF from >= len THEN
  556.    from := len - 1;
  557.  END;
  558.  start := VAL(UNSIGNEDWORD,from);
  559.  
  560.  WHILE (start > 0) AND (s[start] <> c) DO
  561.    DEC(start);
  562.  END;
  563.  
  564.  IF s[start] = c THEN
  565.    RETURN(VAL(INTEGER,start));
  566.  ELSE
  567.    RETURN(NOTFOUND);
  568.  END;
  569. END RPOSCHR;
  570.  
  571. (*---------------------------------------------------------------------------*)
  572.  
  573. PROCEDURE LPOSCHRSET ((* EIN/ -- *)     from : CARDINAL;
  574.                       (* EIN/ -- *) REF set  : ARRAY OF CHAR;
  575.                       (* EIN/ -- *) REF str  : ARRAY OF CHAR ): INTEGER;
  576. (*T*)
  577. VAR         strLen : CARDINAL;
  578.     __REG__ setIdx : UNSIGNEDWORD;
  579.     __REG__ setLen : UNSIGNEDWORD;
  580.     __REG__ c      : CHAR;
  581.  
  582. BEGIN
  583.  strLen := SLEN(str);
  584.  setLen := VAL(UNSIGNEDWORD,SLEN(set));
  585.  IF (from >= strLen) OR (setLen = 0) THEN
  586.    RETURN(NOTFOUND);
  587.  END;
  588.  
  589.  LOOP
  590.    c      := str[VAL(UNSIGNEDWORD,from)];
  591.    setIdx := 0;
  592.    WHILE (setIdx < setLen) AND (c <> set[setIdx]) DO
  593.      INC(setIdx);
  594.    END;
  595.  
  596.    IF setIdx < setLen THEN
  597.      RETURN(CAST(INTEGER,from));
  598.    ELSIF from >= strLen THEN
  599.      RETURN(NOTFOUND);
  600.    ELSE
  601.      INC(from);
  602.    END;
  603.  END;
  604. END LPOSCHRSET;
  605.  
  606. (*---------------------------------------------------------------------------*)
  607.  
  608. PROCEDURE RPOSCHRSET ((* EIN/ -- *)     from : CARDINAL;
  609.                       (* EIN/ -- *) REF set  : ARRAY OF CHAR;
  610.                       (* EIN/ -- *) REF str  : ARRAY OF CHAR ): INTEGER;
  611. (*T*)
  612. VAR         strLen : CARDINAL;
  613.     __REG__ setIdx : UNSIGNEDWORD;
  614.     __REG__ setLen : UNSIGNEDWORD;
  615.     __REG__ c      : CHAR;
  616.  
  617. BEGIN
  618.  strLen := SLEN(str);
  619.  setLen := VAL(UNSIGNEDWORD,SLEN(set));
  620.  
  621.  IF (setLen = 0) OR (strLen = 0) THEN
  622.    RETURN(NOTFOUND);
  623.  ELSIF from >= strLen THEN
  624.    from := strLen - 1;
  625.  END;
  626.  
  627.  LOOP
  628.    c      := str[VAL(UNSIGNEDWORD,from)];
  629.    setIdx := 0;
  630.    WHILE (setIdx < setLen) AND (c <> set[setIdx]) DO
  631.      INC(setIdx);
  632.    END;
  633.  
  634.    IF setIdx < setLen THEN
  635.      RETURN(CAST(INTEGER,from));
  636.    ELSIF from = 0 THEN
  637.      RETURN(NOTFOUND);
  638.    ELSE
  639.      DEC(from);
  640.    END;
  641.  END;
  642. END RPOSCHRSET;
  643.  
  644. END pSTRING.
  645.  
  646.