f675044f54b02a7f2f31b4dea7038fa260b7ef6c
1 MODULE Strings;
3 (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 System/Mod/Strings.txt *)
4 (* DO NOT EDIT *)
6 IMPORT Math;
8 CONST
9 charCode* = -1; decimal* = 10; hexadecimal* = -2; roman*= -3;
10 digitspace* = 08FX;
11 showBase* = TRUE; hideBase* = FALSE;
12 minLongIntRev = "8085774586302733229"; (* reversed string of -MIN(LONGINT) *)
14 VAR
15 maxExp: INTEGER;
16 maxDig: INTEGER;
17 factor: REAL; (* 10^maxDig *)
18 digits: ARRAY 17 OF CHAR;
19 toUpper, toLower: ARRAY 256 OF CHAR;
22 (* integer conversions *)
24 PROCEDURE IntToString* (x: LONGINT; OUT s: ARRAY OF CHAR);
25 VAR j, k: INTEGER; ch: CHAR; a: ARRAY 32 OF CHAR;
26 BEGIN
27 IF x # MIN(LONGINT) THEN
28 IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END;
29 j := 0; REPEAT a[j] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(j) UNTIL x = 0
30 ELSE
31 a := minLongIntRev; s[0] := "-"; k := 1;
32 j := 0; WHILE a[j] # 0X DO INC(j) END
33 END;
34 ASSERT(k + j < LEN(s), 23);
35 REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
36 s[k] := 0X
37 END IntToString;
39 PROCEDURE IntToStringForm* (x: LONGINT; form, minWidth: INTEGER; fillCh: CHAR;
40 showBase: BOOLEAN; OUT s: ARRAY OF CHAR);
41 VAR base, i, j, k, si: INTEGER; mSign: BOOLEAN; a: ARRAY 128 OF CHAR; c1, c5, c10: CHAR;
42 BEGIN
43 ASSERT((form = charCode) OR (form = hexadecimal) OR (form = roman) OR ((form >= 2) & (form <= 16)), 20);
44 ASSERT(minWidth >= 0, 22);
45 IF form = charCode THEN base := 16
46 ELSIF form = hexadecimal THEN base := 16
47 ELSE base := form
48 END;
50 IF form = roman THEN
51 ASSERT((x > 0) & (x < 3999), 21);
52 base := 1000; i := 0; mSign := FALSE;
53 WHILE (base > 0) & (x > 0) DO
54 IF base = 1 THEN c1 := "I"; c5 := "V"; c10 := "X"
55 ELSIF base = 10 THEN c1 := "X"; c5 := "L"; c10 := "C"
56 ELSIF base = 100 THEN c1 := "C"; c5 := "D"; c10 := "M"
57 ELSE c1 := "M"
58 END;
59 k := SHORT(x DIV base); x := x MOD base;
60 IF k IN {4, 9} THEN a[i] := c1; INC(i) END;
61 IF k IN {4 .. 8} THEN a[i] := c5; INC(i) END;
62 IF k = 9 THEN a[i] := c10; INC(i)
63 ELSIF k IN {1 .. 3, 6 .. 8} THEN
64 j := k MOD 5;
65 REPEAT a[i] := c1; INC(i); DEC(j) UNTIL j = 0
66 END;
67 base := base DIV 10
68 END
69 ELSIF (form = hexadecimal) OR (form = charCode) THEN
70 i := 0; mSign := FALSE;
71 IF showBase THEN DEC(minWidth) END;
72 REPEAT
73 a[i] := digits[x MOD base]; x := x DIV base; INC(i)
74 UNTIL (x = 0) OR (x = -1) OR (i = LEN(a));
75 IF x = -1 THEN fillCh := "F" END
76 ELSE
77 IF x < 0 THEN
78 i := 0; mSign := TRUE; DEC(minWidth);
79 REPEAT
80 IF x MOD base = 0 THEN
81 a[i] := digits[0]; x := x DIV base
82 ELSE
83 a[i] := digits[base - x MOD base]; x := x DIV base + 1
84 END;
85 INC(i)
86 UNTIL (x = 0) OR (i = LEN(a))
87 ELSE
88 i := 0; mSign := FALSE;
89 REPEAT
90 a[i] := digits[x MOD base]; x := x DIV base; INC(i)
91 UNTIL (x = 0) OR (i = LEN(a))
92 END;
93 IF showBase THEN DEC(minWidth);
94 IF base < 10 THEN DEC(minWidth) ELSE DEC(minWidth,2) END
95 END
96 END;
97 si := 0;
98 IF mSign & (fillCh = "0") & (si < LEN(s)) THEN s[si] := "-"; INC(si); mSign := FALSE END;
99 WHILE minWidth > i DO
100 IF si < LEN(s) THEN s[si] := fillCh; INC(si) END;
101 DEC(minWidth)
102 END;
103 IF mSign & (si < LEN(s)) THEN s[si] := "-"; INC(si) END;
104 IF form = roman THEN
105 j := 0;
106 WHILE j < i DO
107 IF si < LEN(s) THEN s[si] := a[j]; INC(si) END;
108 INC(j)
109 END
110 ELSE
111 REPEAT DEC(i);
112 IF si < LEN(s) THEN s[si] := a[i]; INC(si) END
113 UNTIL i = 0
114 END;
115 IF showBase & (form # roman) THEN
116 IF (form = charCode) & (si < LEN(s)) THEN s[si] := "X"; INC(si)
117 ELSIF (form = hexadecimal) & (si < LEN(s)) THEN s[si] := "H"; INC(si)
118 ELSIF (form < 10) & (si < LEN(s)-1) THEN s[si] := "%"; s[si+1] := digits[base]; INC(si, 2)
119 ELSIF (si < LEN(s) - 2) THEN
120 s[si] := "%"; s[si+1] := digits[base DIV 10]; s[si+2] := digits[base MOD 10]; INC(si, 3)
121 END
122 END;
123 IF si < LEN(s) THEN s[si] := 0X ELSE HALT(23) END
124 END IntToStringForm;
126 PROCEDURE StringToInt* (IN s: ARRAY OF CHAR; OUT x: INTEGER; OUT res: INTEGER);
127 CONST hexLimit = MAX(INTEGER) DIV 8 + 1;
128 VAR i, j, k, digits: INTEGER; ch, top: CHAR; neg: BOOLEAN; base: INTEGER;
129 BEGIN
130 res := 0; i := 0; ch := s[0];
131 WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO (* ignore leading blanks *)
132 INC(i); ch := s[i]
133 END;
134 j := i; top := "0";
135 WHILE (ch # 0X) & (ch # "H") & (ch # "X") & (ch # "%") DO
136 IF ch > top THEN top := ch END;
137 INC(j); ch := s[j]
138 END;
139 IF (ch = "H") OR (ch = "X") THEN
140 x := 0; ch := s[i];
141 IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
142 WHILE ch = "0" DO INC(i); ch := s[i] END;
143 digits := 0;
144 WHILE (res = 0) & (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) DO
145 IF ch < "A" THEN k := ORD(ch) - ORD("0")
146 ELSE k := ORD(ch) - ORD("A") + 10
147 END;
148 IF digits < 8 THEN
149 x := x MOD hexLimit;
150 IF x >= hexLimit DIV 2 THEN x := x - hexLimit END;
151 x := x * 16 + k; INC(i); ch := s[i]
152 ELSE res := 1
153 END;
154 INC(digits)
155 END;
156 IF res = 0 THEN
157 IF (ch # "H") & (ch # "X") OR (s[i+1] # 0X) THEN res := 2 END
158 END
159 ELSE res := 2
160 END
161 ELSE
162 IF ch = "%" THEN
163 INC(j); ch := s[j]; base := 0;
164 IF ("0" <= ch) & (ch <= "9") THEN
165 k := ORD(ch) - ORD("0");
166 REPEAT
167 base := base * 10 + k;
168 INC(j); ch := s[j]; k := ORD(ch) - ORD("0")
169 UNTIL (ch < "0") OR (ch > "9") OR (base > (MAX(INTEGER) - k) DIV 10);
170 IF ("0" <= ch) & (ch <= "9") THEN base := 0 END
171 END
172 ELSE
173 base := 10
174 END;
176 IF (base < 2) OR (base > 16) THEN
177 res := 2
178 ELSIF (base <= 10) & (ORD(top) < base + ORD("0"))
179 OR (base > 10) & (ORD(top) < base - 10 + ORD("A")) THEN
180 x := 0; ch := s[i]; neg := FALSE;
181 IF ch = "-" THEN INC(i); ch := s[i]; neg := TRUE ELSIF ch = "+" THEN INC(i); ch := s[i] END;
182 WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
183 IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
184 IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END;
185 WHILE (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) & (res = 0) DO
186 IF x >= (MIN(INTEGER) + (base - 1) + k) DIV base THEN
187 x := x * base - k; INC(i); ch := s[i];
188 IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END
189 ELSE res := 1
190 END
191 END
192 ELSE res := 2
193 END;
194 IF res = 0 THEN
195 IF ~neg THEN
196 IF x > MIN(INTEGER) THEN x := -x ELSE res := 1 END
197 END;
198 IF (ch # 0X) & (ch # "%") THEN res := 2 END
199 END
200 ELSE
201 res := 2
202 END
203 END
204 END StringToInt;
206 PROCEDURE StringToLInt* (IN s: ARRAY OF CHAR; OUT x: LONGINT; OUT res: INTEGER);
207 CONST hexLimit = MAX(LONGINT) DIV 8 + 1;
208 VAR i, j, k, digits: INTEGER; ch, top: CHAR; neg: BOOLEAN; base: INTEGER;
209 BEGIN
210 res := 0; i := 0; ch := s[0];
211 WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO (* ignore leading blanks *)
212 INC(i); ch := s[i]
213 END;
214 j := i; top := "0";
215 WHILE (ch # 0X) & (ch # "H") & (ch # "X") & (ch # "%") DO
216 IF ch > top THEN top := ch END;
217 INC(j); ch := s[j]
218 END;
219 IF (ch = "H") OR (ch = "X") THEN
220 x := 0; ch := s[i];
221 IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
222 WHILE ch = "0" DO INC(i); ch := s[i] END;
223 digits := 0;
224 WHILE (res = 0) & (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) DO
225 IF ch < "A" THEN k := ORD(ch) - ORD("0")
226 ELSE k := ORD(ch) - ORD("A") + 10
227 END;
228 IF digits < 16 THEN
229 x := x MOD hexLimit;
230 IF x >= hexLimit DIV 2 THEN x := x - hexLimit END;
231 x := x * 16 + k; INC(i); ch := s[i]
232 ELSE res := 1
233 END;
234 INC(digits)
235 END;
236 IF res = 0 THEN
237 IF (ch # "H") & (ch # "X") OR (s[i+1] # 0X) THEN res := 2 END
238 END
239 ELSE res := 2
240 END
241 ELSE
242 IF ch = "%" THEN
243 INC(j); ch := s[j]; base := 0;
244 IF ("0" <= ch) & (ch <= "9") THEN
245 k := ORD(ch) - ORD("0");
246 REPEAT
247 base := base * 10 + k;
248 INC(j); ch := s[j]; k := ORD(ch) - ORD("0")
249 UNTIL (ch < "0") OR (ch > "9") OR (base > (MAX(INTEGER) - k) DIV 10);
250 IF ("0" <= ch) & (ch <= "9") THEN base := 0 END
251 END
252 ELSE
253 base := 10
254 END;
256 IF (base < 2) OR (base > 16) THEN
257 res := 2
258 ELSIF (base <= 10) & (ORD(top) < base + ORD("0"))
259 OR (base > 10) & (ORD(top) < base -10 + ORD("A")) THEN
260 x := 0; ch := s[i]; neg := FALSE;
261 IF ch = "-" THEN INC(i); ch := s[i]; neg := TRUE ELSIF ch = "+" THEN INC(i); ch := s[i] END;
262 WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
263 IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
264 IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END;
265 WHILE (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) & (res = 0) DO
266 IF x >= (MIN(LONGINT) + (base - 1) + k) DIV base THEN
267 x := x * base - k; INC(i); ch := s[i];
268 IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END
269 ELSE res := 1
270 END
271 END
272 ELSE res := 2
273 END;
274 IF res = 0 THEN
275 IF ~neg THEN
276 IF x > MIN(LONGINT) THEN x := -x ELSE res := 1 END
277 END;
278 IF (ch # 0X) & (ch # "%") THEN res := 2 END
279 END
280 ELSE
281 res := 2
282 END
283 END
284 END StringToLInt;
287 (* real conversions *)
289 PROCEDURE RealToStringForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR;
290 OUT s: ARRAY OF CHAR);
291 VAR exp, len, i, j, n, k, p: INTEGER; m: ARRAY 80 OF CHAR; neg: BOOLEAN;
292 BEGIN
293 ASSERT((precision > 0) (*& (precision <= 18)*), 20);
294 ASSERT((minW >= 0) & (minW < LEN(s)), 21);
295 ASSERT((expW > -LEN(s)) & (expW <= 3), 22);
296 exp := Math.Exponent(x);
297 IF exp = MAX(INTEGER) THEN
298 IF fillCh = "0" THEN fillCh := digitspace END;
299 x := Math.Mantissa(x);
300 IF x = -1 THEN m := "-inf"; n := 4
301 ELSIF x = 1 THEN m := "inf"; n := 3
302 ELSE m := "nan"; n := 3
303 END;
304 i := 0; j := 0;
305 WHILE minW > n DO s[i] := fillCh; INC(i); DEC(minW) END;
306 WHILE (j <= n) & (i < LEN(s)) DO s[i] := m[j]; INC(i); INC(j) END
307 ELSE
308 neg := FALSE; len := 1; m := "00";
309 IF x < 0 THEN x := -x; neg := TRUE; DEC(minW) END;
310 IF x # 0 THEN
311 exp := (exp - 8) * 30103 DIV 100000; (* * log(2) *)
312 IF exp > 0 THEN
313 n := SHORT(ENTIER(x / Math.IntPower(10, exp)));
314 x := x / Math.IntPower(10, exp) - n
315 ELSIF exp > -maxExp THEN
316 n := SHORT(ENTIER(x * Math.IntPower(10, -exp)));
317 x := x * Math.IntPower(10, -exp) - n
318 ELSE
319 n := SHORT(ENTIER(x * Math.IntPower(10, -exp - 2 * maxDig) * factor * factor));
320 x := x * Math.IntPower(10, -exp - 2 * maxDig) * factor * factor - n
321 END;
322 (* x0 = (n + x) * 10^exp, 200 < n < 5000 *)
323 p := precision - 4;
324 IF n < 1000 THEN INC(p) END;
325 IF (expW < 0) & (p > exp - expW) THEN p := exp - expW END;
326 IF p >= 0 THEN
327 x := x + 0.5 / Math.IntPower(10, p); (* rounding correction *)
328 IF x >= 1 THEN INC(n); x := x - 1 END
329 ELSIF p = -1 THEN INC(n, 5)
330 ELSIF p = -2 THEN INC(n, 50)
331 ELSIF p = -3 THEN INC(n, 500)
332 END;
333 i := 0; k := 1000; INC(exp, 3);
334 IF n < 1000 THEN k := 100; DEC(exp) END;
335 WHILE (i < precision) & ((k > 0) OR (x # 0)) DO
336 IF k > 0 THEN p := n DIV k; n := n MOD k; k := k DIV 10
337 ELSE x := x * 10; p := SHORT(ENTIER(x)); x := x - p
338 END;
339 m[i] := CHR(p + ORD("0")); INC(i);
340 IF p # 0 THEN len := i END
341 END
342 END;
343 (* x0 = m[0].m[1]...m[len-1] * 10^exp *)
344 i := 0;
345 IF (expW < 0) OR (expW = 0) & (exp >= -3) & (exp <= len + 1) THEN
346 n := exp + 1; k := len - n;
347 IF n < 1 THEN n := 1 END;
348 IF expW < 0 THEN k := -expW ELSIF k < 1 THEN k := 1 END;
349 j := minW - n - k - 1; p := -exp;
350 IF neg & (p >= MAX(0, n) + MAX(0, k)) THEN neg := FALSE; INC(j) END
351 ELSE
352 IF ABS(exp) >= 100 THEN expW := 3
353 ELSIF (expW < 2) & (ABS(exp) >= 10) THEN expW := 2
354 ELSIF expW < 1 THEN expW := 1
355 END;
356 IF len < 2 THEN len := 2 END;
357 j := minW - len - 3 - expW; k := len;
358 IF j > 0 THEN
359 k := k + j; j := 0;
360 IF k > precision THEN j := k - precision; k := precision END
361 END;
362 n := 1; DEC(k); p := 0
363 END;
364 IF neg & (fillCh = "0") THEN s[i] := "-"; INC(i); neg := FALSE END;
365 WHILE j > 0 DO s[i] := fillCh; INC(i); DEC(j) END;
366 IF neg & (i < LEN(s)) THEN s[i] := "-"; INC(i) END;
367 j := 0;
368 WHILE (n > 0) & (i < LEN(s)) DO
369 IF (p <= 0) & (j < len) THEN s[i] := m[j]; INC(j) ELSE s[i] := "0" END;
370 INC(i); DEC(n); DEC(p)
371 END;
372 IF i < LEN(s) THEN s[i] := "."; INC(i) END;
373 WHILE (k > 0) & (i < LEN(s)) DO
374 IF (p <= 0) & (j < len) THEN s[i] := m[j]; INC(j) ELSE s[i] := "0" END;
375 INC(i); DEC(k); DEC(p)
376 END;
377 IF expW > 0 THEN
378 IF i < LEN(s) THEN s[i] := "E"; INC(i) END;
379 IF i < LEN(s) THEN
380 IF exp < 0 THEN s[i] := "-"; exp := -exp ELSE s[i] := "+" END;
381 INC(i)
382 END;
383 IF (expW = 3) & (i < LEN(s)) THEN s[i] := CHR(exp DIV 100 + ORD("0")); INC(i) END;
384 IF (expW >= 2) & (i < LEN(s)) THEN s[i] := CHR(exp DIV 10 MOD 10 + ORD("0")); INC(i) END;
385 IF i < LEN(s) THEN s[i] := CHR(exp MOD 10 + ORD("0")); INC(i) END
386 END
387 END;
388 IF i < LEN(s) THEN s[i] := 0X ELSE HALT(23) END
389 END RealToStringForm;
391 PROCEDURE RealToString* (x: REAL; OUT s: ARRAY OF CHAR);
392 BEGIN
393 RealToStringForm(x, 16, 0, 0, digitspace, s)
394 END RealToString;
397 PROCEDURE StringToReal* (IN s: ARRAY OF CHAR; OUT x: REAL; OUT res: INTEGER);
398 VAR first, last, point, e, n, i, exp: INTEGER; y: REAL; ch: CHAR; neg, negExp, dig: BOOLEAN;
399 BEGIN
400 res := 0; i := 0; ch := s[0]; dig := FALSE;
401 WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO INC(i); ch := s[i] END;
402 IF ch = "+" THEN
403 neg := FALSE; INC(i); ch := s[i]
404 ELSIF ch = "-" THEN
405 neg := TRUE; INC(i); ch := s[i]
406 ELSE
407 neg := FALSE
408 END;
409 WHILE ch = "0" DO INC(i); ch := s[i]; dig := TRUE END;
410 first := i; e := 0;
411 WHILE ("0" <= ch) & (ch <= "9") DO INC(i); ch := s[i]; INC(e); dig := TRUE END;
412 point := i;
413 IF ch = "." THEN
414 INC(i); ch := s[i];
415 IF e = 0 THEN
416 WHILE ch = "0" DO INC(i); ch := s[i]; DEC(e); dig := TRUE END;
417 first := i
418 END;
419 WHILE ("0" <= ch) & (ch <= "9") DO INC(i); ch := s[i]; dig := TRUE END
420 END;
421 last := i - 1; exp := 0;
422 IF (ch = "E") OR (ch = "D") THEN
423 INC(i); ch := s[i]; negExp := FALSE;
424 IF ch = "-" THEN negExp := TRUE; INC(i); ch := s[i]
425 ELSIF ch = "+" THEN INC(i); ch := s[i]
426 END;
427 WHILE ("0" <= ch) & (ch <= "9") & (exp < 1000) DO
428 exp := exp * 10 + (ORD(ch) - ORD("0"));
429 INC(i); ch := s[i]
430 END;
431 IF negExp THEN exp := -exp END
432 END;
433 exp := exp + e; x := 0; y := 0; n := 0;
434 WHILE (n < maxDig) & (first <= last) DO
435 IF first # point THEN x := x * 10 + (ORD(s[first]) - ORD("0")); INC(n) END;
436 INC(first)
437 END;
438 WHILE last >= first DO
439 IF last # point THEN y := (y + (ORD(s[last]) - ORD("0"))) / 10 END;
440 DEC(last)
441 END;
442 IF ~dig OR (ch # 0X) THEN res := 2 (* syntax error *)
443 ELSIF exp < -maxExp - maxDig THEN
444 x := 0.0
445 ELSIF exp < -maxExp + maxDig THEN
446 x := (x + y) / Math.IntPower(10, n - exp - 2 * maxDig) / factor / factor
447 ELSIF exp < n THEN
448 x := (x + y) / Math.IntPower(10, n - exp)
449 ELSIF exp < maxExp THEN
450 x := (x + y) * Math.IntPower(10, exp - n)
451 ELSIF exp = maxExp THEN
452 x := (x + y) * (Math.IntPower(10, exp - n) / 16);
453 IF x <= MAX(REAL) / 16 THEN x := x * 16
454 ELSE res := 1 (* overflow *)
455 END
456 ELSE res := 1 (* overflow *)
457 END;
458 IF neg THEN x := -x END
459 END StringToReal;
461 (* ----------------------------- string manipulation routines --------------------------- *)
463 PROCEDURE Valid* (IN s: ARRAY OF CHAR): BOOLEAN;
464 VAR i: INTEGER;
465 BEGIN i := 0;
466 WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
467 RETURN i < LEN(s)
468 END Valid;
470 PROCEDURE Upper* (ch: CHAR): CHAR;
471 BEGIN
472 IF ORD(ch) < 256 THEN RETURN toUpper[ORD(ch)] ELSE RETURN ch END
473 END Upper;
475 PROCEDURE ToUpper* (in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
476 VAR i, max: INTEGER;
477 BEGIN i := 0; max := LEN(out)-1;
478 WHILE (in[i] # 0X) & (i < max) DO
479 IF ORD(in[i]) < 256 THEN out[i] := toUpper[ORD(in[i])] ELSE out[i] := in[i] END;
480 INC(i)
481 END;
482 out[i] := 0X
483 END ToUpper;
485 PROCEDURE Lower* (ch: CHAR): CHAR;
486 BEGIN
487 IF ORD(ch) < 256 THEN RETURN toLower[ORD(ch)] ELSE RETURN ch END
488 END Lower;
490 PROCEDURE ToLower* (in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
491 VAR i, max: INTEGER;
492 BEGIN i := 0; max := LEN(out)-1;
493 WHILE (in[i] # 0X) & (i < max) DO
494 IF ORD(in[i]) < 256 THEN out[i] := toLower[ORD(in[i])] ELSE out[i] := in[i] END;
495 INC(i)
496 END;
497 out[i] := 0X
498 END ToLower;
500 PROCEDURE Replace* (VAR s: ARRAY OF CHAR; pos, len: INTEGER; IN rep: ARRAY OF CHAR);
501 (* replace stretch s[pos]..s[pos+len-1] with rep *)
502 (* insert semantics if len = 0; delete semantics if Len(rep) = 0 *)
503 VAR i, j, k, max, lenS: INTEGER; ch: CHAR;
504 BEGIN
505 ASSERT(len >= 0, 20); ASSERT(pos >= 0, 21);
506 lenS := LEN(s$); max := LEN(s) - 1;
507 IF pos <= lenS THEN i := pos; j := 0;
508 IF pos+len > lenS THEN len := lenS - pos END;
509 WHILE (rep[j] # 0X) & (len > 0) DO
510 s[i] := rep[j]; INC(i); INC(j); DEC(len)
511 END;
512 IF len > 0 THEN (* delete the remaining part of the stretch [pos, pos+len) *)
513 REPEAT ch := s[i+len]; s[i] := ch; INC(i) UNTIL ch = 0X
514 ELSE (* insert the remaining part of rep *)
515 len := LEN(rep$) - j; k := lenS + len;
516 IF k > max THEN k := max END;
517 s[k] := 0X;
518 WHILE k - len >= i DO s[k] := s[k-len]; DEC(k) END;
519 WHILE (rep[j] # 0X) & (i < max) DO s[i] := rep[j]; INC(i); INC(j) END
520 END
521 END
522 END Replace;
524 PROCEDURE Extract* (s: ARRAY OF CHAR; pos, len: INTEGER; OUT res: ARRAY OF CHAR);
525 VAR i, j, max: INTEGER;
526 BEGIN
527 ASSERT(len >= 0, 20); ASSERT(pos >= 0, 21);
528 i := 0; j := 0; max := LEN(res) - 1;
529 WHILE (i < pos) & (s[i] # 0X) DO INC(i) END;
530 WHILE (j < len) & (j < max) & (s[i] # 0X) DO res[j] := s[i]; INC(j); INC(i) END;
531 res[j] := 0X
532 END Extract;
534 PROCEDURE Find* (IN s: ARRAY OF CHAR; IN pat: ARRAY OF CHAR; start: INTEGER; OUT pos: INTEGER);
535 VAR j: INTEGER;
536 BEGIN
537 ASSERT(start >= 0, 20);
538 IF (start = 0) OR (start <= LEN(s$) - LEN(pat$)) THEN
539 (* start = 0 is optimization: need not call Len *)
540 pos := start;
541 WHILE s[pos] # 0X DO j := 0;
542 WHILE (s[pos+j] = pat[j]) & (pat[j] # 0X) DO INC(j) END;
543 IF pat[j] = 0X THEN RETURN END;
544 INC(pos)
545 END
546 END;
547 pos := -1 (* pattern not found *)
548 END Find;
550 PROCEDURE Init;
551 VAR i: INTEGER;
552 BEGIN
553 FOR i := 0 TO 255 DO toUpper[i] := CHR(i); toLower[i] := CHR(i) END;
554 FOR i := ORD("A") TO ORD("Z") DO toLower[i] := CHR(i + 32); toUpper[i + 32] := CHR(i) END;
555 FOR i := ORD("À") TO ORD ("Ö") DO toLower[i] := CHR(i + 32); toUpper[i + 32] := CHR(i) END;
556 FOR i := ORD("Ø") TO ORD ("Þ") DO toLower[i] := CHR(i + 32); toUpper[i + 32] := CHR(i) END;
557 digits := "0123456789ABCDEF";
558 maxExp := SHORT(ENTIER(Math.Log(MAX(REAL)))) + 1;
559 maxDig := SHORT(ENTIER(-Math.Log(Math.Eps())));
560 factor := Math.IntPower(10, maxDig)
561 END Init;
563 BEGIN
564 Init
565 END Strings.