MODULE Strings0;

(* ergänzt Strings *)

IMPORT
  a := ASCII,
  s := Strings,
  u := Utility,
  S := SYSTEM;

(* $RangeChk- $ReturnChk- *)

(* $Debug- *)

PROCEDURE AppendChar * (VAR s : ARRAY OF CHAR; c : CHAR); (* $EntryExitCode- *)
(* hängt c an s an *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1  *)
            121FH,                  (* MOVE.B  (A7)+,D1  *)
            201FH,                  (* MOVE.L  (A7)+,D0  *)
            205FH,                  (* MOVEA.L (A7)+,A0  *)
            5380H,                  (* SUBQ.L  #1,D0     *)
            2408H,                  (* MOVE.L  A0,D2     *)
            7600H,                  (* MOVEQ   #0,D3     *)
            0B083H,                 (* CMP.L   D3,D0     *)
            6F14H,                  (* BLE     L00000026 *)
            5283H,                  (* ADDQ.L  #1,D3     *)
            4A18H,                  (* TST.B   (A0)+     *)
            66F6H,                  (* BNE     L0000000E *)
            2608H,                  (* MOVE.L  A0,D3     *)
            9682H,                  (* SUB.L   D2,D3     *)
            0B680H,                 (* CMP.L   D0,D3     *)
            6E06H,                  (* BGT     L00000026 *)
            10BCH,0000H,            (* MOVE.B  #0,(A0)   *)
            1101H,                  (* MOVE.B  D1,-(A0)  *)
            4ED1H)                  (* JMP     (A1)      *)
END AppendChar;

PROCEDURE Delete * (VAR s : ARRAY OF CHAR); (* $EntryExitCode- *)
(* löscht alle Zeichen in s *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1   *)
            201FH,                  (* MOVE.L  (A7)+,D0   *)
            205FH,                  (* MOVEA.L (A7)+,A0   *)
            5380H,                  (* SUBQ.L  #1,D0      *)
            10FCH, 0000H,           (* MOVE.B  #0,(A0)+   *)
            56C8H, 0FFFAH,          (* DBNE    D0,L000008 *)
            4ED1H)                  (* JMP     (A1)       *)
END Delete;

PROCEDURE FirstPos * (s    : ARRAY OF CHAR;
                      from : LONGINT;
                      c    : CHAR) : LONGINT; (* $EntryExitCode- $CopyArrays- *)
(* Rückgabewert enthält erstes Vorkommen von Zeichen in s ab from *)
(* oder -1 bei Mißerfolg *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1      *)
            121FH,                  (* MOVE.B  (A7)+,D1      *)
            201FH,                  (* MOVE.L  (A7)+,D0      *)
            241FH,                  (* MOVE.L  (A7)+,D2      *)
            205FH,                  (* MOVEA.L (A7)+,A0      *)
            4A80H,                  (* TST.L   D0            *)
            6D16H,                  (* BLT.S   L000024       *)
            0B480H,                 (* CMP.L   D0,D2         *)
            6F12H,                  (* BLE.S   L000024       *)
            4A30H, 0800H,           (* TST.B   0(A0,D0.L)    *)
            670CH,                  (* BEQ.S   L000024       *)
            0B230H, 0800H,          (* CMP.B   0(A0,D0.L),D1 *)
            6704H,                  (* BEQ.S   L000022       *)
            5280H,                  (* ADDQ.L  #1,D0         *)
            60ECH,                  (* BRA.S   L00000E       *)
            4ED1H,                  (* JMP     (A1)          *)
            70FFH,                  (* MOVEQ   #-1,D0        *)
            4ED1H)                  (* JMP     (A1)          *)
END FirstPos;

PROCEDURE InsertChar * (VAR s  : ARRAY OF CHAR;
                            at : LONGINT;
                            c  : CHAR); (* $EntryExitCode- *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1               *)
            121FH,                  (* MOVE.B  (A7)+,D1               *)
            201FH,                  (* MOVE.L  (A7)+,D0               *)
            241FH,                  (* MOVE.L  (A7)+,D2               *)
            205FH,                  (* MOVEA.L (A7)+,A0               *)
            4A80H,                  (* TST.L   D0                     *)
            6D22H,                  (* BLT.S   L000030                *)
            2448H,                  (* MOVEA.L A0,A2                  *)
            4A1AH,                  (* TST.B   (A2)+                  *)
            66FCH,                  (* BNE.S   L000010                *)
            260AH,                  (* MOVE.L  A2,D3                  *)
            9688H,                  (* SUB.L   A0,D3                  *)
            0B682H,                 (* CMP.L   D2,D3                  *)
            6C14H,                  (* BGE.S   L000030                *)
            0B680H,                 (* CMP.L   D0,D3                  *)
            6F10H,                  (* BLE.S   L000030                *)
            11B0H, 38FFH, 3800H,    (* MOVE.B  -1(A0,D3.L),0(A0,D3.L) *)
            5383H,                  (* SUBQ.L  #1,D3                  *)
            0B680H,                 (* CMP.L   D0,D3                  *)
            6EF4H,                  (* BGT.S   L000020                *)
            1181H, 0800H,           (* MOVE.B  D1,0(A0,D0.L)          *)
            4ED1H)                  (* JMP     (A1)                   *)
END InsertChar;

PROCEDURE LastPos * (s  : ARRAY OF CHAR;
                     to : LONGINT;
                     c  : CHAR) : LONGINT; (* $EntryExitCode- $CopyArrays- *)
(* Rückgabewert enthält letztes Vorkommen von Zeichen in s bis to *)
(* oder -1 bei Mißerfolg *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1      *)
            121FH,                  (* MOVE.B  (A7)+,D1      *)
            201FH,                  (* MOVE.L  (A7)+,D0      *)
            241FH,                  (* MOVE.L  (A7)+,D2      *)
            205FH,                  (* MOVEA.L (A7)+,A0      *)
            4A80H,                  (* TST.L   D0            *)
            6D0CH,                  (* BLT.S   L00001A       *)
            0B230H, 0800H,          (* CMP.B   0(A0,D0.L),D1 *)
            6704H,                  (* BEQ.S   L000018       *)
            5380H,                  (* SUBQ.L  #1,D0         *)
            60F2H,                  (* BRA.S   L00000A       *)
            4ED1H,                  (* JMP     (A1)          *)
            70FFH,                  (* MOVEQ   #-1,D0        *)
            4ED1H)                  (* JMP     (A1)          *)
END LastPos;

PROCEDURE ReplaceChar * (VAR s    : ARRAY OF CHAR;
                             o, n : CHAR); (* $EntryExitCode- *)
(* ersetzt in s alle o durch n *)
BEGIN
  S.INLINE (225FH,                  (* MOVEA.L (A7)+,A1      *)
            141FH,                  (* MOVE.B  (A7)+,D2      *)
            121FH,                  (* MOVE.B  (A7)+,D1      *)
            201FH,                  (* MOVE.L  (A7)+,D0      *)
            205FH,                  (* MOVEA.L (A7)+,A0      *)
            7600H,                  (* MOVEQ   #0,D3         *)
            0B680H,                 (* CMP.L   D0,D3         *)
            6C14H,                  (* BGE.S   L000024       *)
            4A30H, 3800H,           (* TST.B   0(A0,D3.L)    *)
            670EH,                  (* BEQ.S   L000024       *)
            0B230H, 3800H,          (* CMP.B   0(A0,D3.L),D1 *)
            6604H,                  (* BNE.S   L000020       *)
            1182H, 3800H,           (* MOVE.B  D2,0(A0,D3.L) *)
            5283H,                  (* ADDQ.L  #1,D3         *)
            60E8H,                  (* BRA.S   L00000C       *)
            4ED1H)                  (* JMP     (A1)          *)
END ReplaceChar;

(* $RangeChk= $ReturnChk= *)

PROCEDURE Append * (VAR str : ARRAY OF CHAR;
                    source  : ARRAY OF CHAR;
                    len     : LONGINT); (* $CopyArrays- *)
(* hängt die ersten len Zeichen aus source an str an *)
VAR
  index : LONGINT;
BEGIN
  index := 0;
  LOOP
    IF (index = len) OR (index = LEN (str)) OR (index = LEN (source)) OR
       (source [index] = a.nul) THEN
      EXIT
    END;
    AppendChar (str, source [index]);
    INC (index)
  END;
  FOR index := s.Length (source) TO len - 1 DO
    AppendChar (str, a.sp)
  END
END Append;

PROCEDURE Compare * (str1, str2 : ARRAY OF CHAR;
                     caseSens   : BOOLEAN) : BOOLEAN; (* $CopyArrays- *)
(* vergleicht str1 mit str2; caseSens gibt an, ob zwischen Groß-         *)
(* und Kleinschreibung unterschieden werden soll; der Rückgabewert zeigt *)
(* die Gleichheit an *)
VAR
  index : LONGINT;
BEGIN
  index := 0;
  LOOP
    IF (str1 [index] = a.nul) OR (str2 [index] = a.nul) THEN
      EXIT
    END;
    IF   caseSens & (     str1 [index]  #      str2 [index])   OR
       ~ caseSens & (CAP (str1 [index]) # CAP (str2 [index])) THEN
      EXIT
    END;
    INC (index)
  END;
  RETURN (str1 [index] = a.nul) & (str2 [index] = a.nul)
END Compare;

(* $Debug= *)

PROCEDURE Fill * (VAR str : ARRAY OF CHAR; from, len : LONGINT; FillChar : CHAR);
(* schreibt len FillChar-Zeichen ab from in str *)
VAR
  pos, length : LONGINT;
BEGIN
  pos := from;
  LOOP
    IF (pos >= LEN (str) - 1) OR (pos >= from + len) THEN
      EXIT
    END;
    length := s.Length (str);
    IF (pos < length) & (length < LEN (str) - 1) THEN
      InsertChar (str, pos, FillChar)
    ELSE
      str [pos] := FillChar
    END;
    INC (pos)
  END;
  IF pos < LEN (str) THEN
    str [pos] := a.nul
  END
END Fill;

(* $Debug- *)

PROCEDURE Greater * (str1, str2 : ARRAY OF CHAR;
                     caseSens   : BOOLEAN) : BOOLEAN; (* $CopyArrays- *)
(* vergleicht str1 mit str2; caseSens gibt an, ob zwischen Groß- und     *)
(* Kleinschreibung unterschieden werden soll; ist der Rückgabewert TRUE, *)
(* steht str1 alphabetisch hinter str2 *)
BEGIN
  IF caseSens THEN
    RETURN u.Stricmp (str1, str2) > 0
  ELSE
    RETURN u.Strnicmp (str1, str2, s.Length (str1) + 1) > 0
  END
END Greater;

(* $Debug= *)

PROCEDURE Insert * (VAR str : ARRAY OF CHAR;
                    pos     : LONGINT;
                    source  : ARRAY OF CHAR); (* $CopyArrays- *)
(* funktioniert nicht, wenn "str" ein Registerparameter ist *)
VAR
  index, length : LONGINT;
BEGIN
  IF (pos >= 0) & (pos < LEN (str)) THEN
    WHILE pos > s.Length (str) DO
      AppendChar (str, a.sp)
    END;
    index := 0;
    length := s.Length (source);
    WHILE ~ ((index = LEN (str)) OR (index = length)) DO
      str [LEN (str) - 2] := a.nul;
      InsertChar (str, pos + index, source [index]);
      INC (index)
    END
  END
END Insert;

PROCEDURE Lower * (VAR str : ARRAY OF CHAR);
VAR
  index : LONGINT;
BEGIN
  FOR index := 0 TO s.Length (str) - 1 DO
    CASE str [index] OF
    | "A" .. "Z" : str [index] := CHR (ORD (str [index]) + 32)
    ELSE END
  END
END Lower;

PROCEDURE Occurs * (String,
                    search : ARRAY OF CHAR) : LONGINT;  (* $CopyArrays- *)
(* Fridtjofs Occurs ohne Unterscheidung zwischen Groß- und Kleinschreibung *)
(* prüft, ob search in String vorkommt und gibt die Position oder -1 zurück *)
VAR l, L, i, j, start : LONGINT;
BEGIN
  l := s.Length (String); L := s.Length (search); start := 0;
  WHILE start <= l - L DO
    j := 0; i := start;
    WHILE (j < L) & (CAP (search [j]) = CAP (String [i])) DO
      INC (j); INC (i)
    END;
    IF j = L THEN RETURN i - L END;
    INC (start)
  END;
  RETURN -1
END Occurs;

PROCEDURE OccursPos * (String,
                       search : ARRAY OF CHAR;
                       start  : LONGINT) : LONGINT; (* $CopyArrays- *)
(* Fridtjofs OccursPos ohne Unterscheidung zwischen Groß- und Kleinschreibung *)
(* prüft, ob search ab Zeichen Nummer start in s vorkommt und gibt die
Position oder -1 zurück *)
VAR
  l, L, i, j : LONGINT;
BEGIN
  l := s.Length (String);
  L := s.Length (search);
  WHILE start < l DO
    j := 0;
    i := start;
    WHILE (j < L) & (CAP (search [j]) = CAP (String [i])) DO
      INC (j);
      INC (i)
    END;
    IF j = L THEN
      RETURN i - L
    END;
    INC (start)
  END;
  RETURN -1;
END OccursPos;

PROCEDURE ReplacePos * (VAR String : ARRAY OF CHAR;
                        old, new   : ARRAY OF CHAR;
                        start      : LONGINT); (* $CopyArrays- *)
VAR index : LONGINT;
BEGIN
  index := start;
  LOOP
    index := s.OccursPos (String, old, index);
    IF index = -1 THEN
      EXIT
    END;
    s.Delete (String, index, s.Length (old));
    Insert (String, index, new)
  END
END ReplacePos;

PROCEDURE Replace * (VAR String : ARRAY OF CHAR;
                     old, new   : ARRAY OF CHAR); (* $CopyArrays- *)
BEGIN
  ReplacePos (String, old, new, 0)
END Replace;

END Strings0.