Strings.txt 18 KB

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