strings.mod 3.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145
  1. IMPLEMENTATION MODULE Strings;
  2. (* NUL-terminated string operations, matching the V3 CHAR-array model
  3. (every CHAR array reserves a terminator slot at index = count) and
  4. gm2's conventions. Length scans for the terminator rather than using
  5. the descriptor count, so fixed-size buffers holding shorter strings
  6. behave correctly. *)
  7. PROCEDURE Length (VAR s : ARRAY OF CHAR) : INTEGER;
  8. VAR i : INTEGER;
  9. BEGIN
  10. i := 0;
  11. WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
  12. RETURN i
  13. END Length;
  14. PROCEDURE Assign (VAR src, dst : ARRAY OF CHAR);
  15. VAR i, n, cap : INTEGER;
  16. BEGIN
  17. n := Length(src);
  18. cap := HIGH(dst);
  19. IF n > cap THEN n := cap END;
  20. i := 0;
  21. WHILE i < n DO
  22. dst[i] := src[i];
  23. i := i + 1
  24. END;
  25. dst[n] := CHR(0)
  26. END Assign;
  27. PROCEDURE Copy (VAR src, dst : ARRAY OF CHAR);
  28. BEGIN
  29. Assign(src, dst)
  30. END Copy;
  31. PROCEDURE Concat (VAR s1, s2 : ARRAY OF CHAR; VAR dst : ARRAY OF CHAR);
  32. VAR i, n1, n2, cap : INTEGER;
  33. BEGIN
  34. n1 := Length(s1);
  35. n2 := Length(s2);
  36. cap := HIGH(dst);
  37. IF n1 > cap THEN n1 := cap END;
  38. IF n1 + n2 > cap THEN n2 := cap - n1 END;
  39. IF n2 < 0 THEN n2 := 0 END;
  40. i := 0;
  41. WHILE i < n1 DO
  42. dst[i] := s1[i];
  43. i := i + 1
  44. END;
  45. i := 0;
  46. WHILE i < n2 DO
  47. dst[n1 + i] := s2[i];
  48. i := i + 1
  49. END;
  50. dst[n1 + n2] := CHR(0)
  51. END Concat;
  52. PROCEDURE Delete (VAR s : ARRAY OF CHAR; start, count : INTEGER);
  53. VAR n, i : INTEGER;
  54. BEGIN
  55. n := Length(s);
  56. IF start < 0 THEN start := 0 END;
  57. IF start > n THEN start := n END;
  58. IF count < 0 THEN count := 0 END;
  59. IF start + count > n THEN count := n - start END;
  60. i := start;
  61. WHILE i + count < n DO
  62. s[i] := s[i + count];
  63. i := i + 1
  64. END;
  65. s[n - count] := CHR(0)
  66. END Delete;
  67. PROCEDURE Append (VAR src, dst : ARRAY OF CHAR);
  68. VAR n, m, cap, i : INTEGER;
  69. BEGIN
  70. n := Length(dst);
  71. m := Length(src);
  72. cap := HIGH(dst);
  73. IF n + m > cap THEN m := cap - n END;
  74. IF m < 0 THEN m := 0 END;
  75. i := 0;
  76. WHILE i < m DO
  77. dst[n + i] := src[i];
  78. i := i + 1
  79. END;
  80. dst[n + m] := CHR(0)
  81. END Append;
  82. PROCEDURE Equal (VAR s1, s2 : ARRAY OF CHAR) : BOOLEAN;
  83. VAR i, n1, n2 : INTEGER;
  84. BEGIN
  85. n1 := Length(s1); n2 := Length(s2);
  86. IF n1 # n2 THEN RETURN FALSE END;
  87. i := 0;
  88. WHILE i < n1 DO
  89. IF s1[i] # s2[i] THEN RETURN FALSE END;
  90. i := i + 1
  91. END;
  92. RETURN TRUE
  93. END Equal;
  94. PROCEDURE Pos (VAR pattern, s : ARRAY OF CHAR) : INTEGER;
  95. VAR i, j, np, ns : INTEGER;
  96. found : BOOLEAN;
  97. BEGIN
  98. np := Length(pattern);
  99. ns := Length(s);
  100. IF (np = 0) OR (np > ns) THEN RETURN 0 END;
  101. i := 0;
  102. WHILE i + np <= ns DO
  103. j := 0; found := TRUE;
  104. WHILE (j < np) AND found DO
  105. IF s[i + j] # pattern[j] THEN
  106. found := FALSE
  107. ELSE
  108. j := j + 1
  109. END
  110. END;
  111. IF found THEN RETURN i + 1 END;
  112. i := i + 1
  113. END;
  114. RETURN 0
  115. END Pos;
  116. PROCEDURE Compare (VAR s1, s2 : ARRAY OF CHAR) : INTEGER;
  117. VAR i, n1, n2, n : INTEGER;
  118. BEGIN
  119. n1 := Length(s1);
  120. n2 := Length(s2);
  121. n := n1;
  122. IF n2 < n THEN n := n2 END;
  123. i := 0;
  124. WHILE i < n DO
  125. IF s1[i] < s2[i] THEN RETURN -1
  126. ELSIF s1[i] > s2[i] THEN RETURN 1
  127. END;
  128. i := i + 1
  129. END;
  130. IF n1 < n2 THEN RETURN -1
  131. ELSIF n1 > n2 THEN RETURN 1
  132. END;
  133. RETURN 0
  134. END Compare;
  135. END Strings.