RealConver.mod 7.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337
  1. (*
  2. (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
  3. See the copyright notice in the ACK home directory, in the file "Copyright".
  4. *)
  5. (*$R-*)
  6. IMPLEMENTATION MODULE RealConversions;
  7. (*
  8. Module: string-to-real and real-to-string conversions
  9. Author: Ceriel J.H. Jacobs
  10. Version: $Id$
  11. *)
  12. PROCEDURE RealToString(arg: REAL;
  13. width, digits: INTEGER;
  14. VAR str: ARRAY OF CHAR;
  15. VAR ok: BOOLEAN);
  16. BEGIN
  17. LongRealToString(LONG(arg), width, digits, str, ok);
  18. END RealToString;
  19. TYPE
  20. Powers = RECORD
  21. pval: LONGREAL;
  22. rpval: LONGREAL;
  23. exp: INTEGER
  24. END;
  25. VAR Powers10: ARRAY[1..6] OF Powers;
  26. PROCEDURE LongRealToString(arg: LONGREAL;
  27. width, digits: INTEGER;
  28. VAR str: ARRAY OF CHAR;
  29. VAR ok: BOOLEAN);
  30. VAR pointpos: INTEGER;
  31. i: CARDINAL;
  32. ecvtflag: BOOLEAN;
  33. r: LONGREAL;
  34. ind1, ind2 : CARDINAL;
  35. sign: BOOLEAN;
  36. ndigits: CARDINAL;
  37. BEGIN
  38. r := arg;
  39. IF digits < 0 THEN
  40. ecvtflag := TRUE;
  41. ndigits := -digits;
  42. ELSE
  43. ecvtflag := FALSE;
  44. ndigits := digits;
  45. END;
  46. IF (HIGH(str) < ndigits + 3) THEN
  47. str[0] := 0C; ok := FALSE; RETURN
  48. END;
  49. pointpos := 0;
  50. sign := r < 0.0D;
  51. IF sign THEN r := -r END;
  52. ok := TRUE;
  53. IF (r <> 0.0D) AND NOT (r / 10.0D < r) THEN
  54. (* assume Nan or Infinity *)
  55. r := 0.0D;
  56. ok := FALSE;
  57. END;
  58. IF r # 0.0D THEN
  59. IF r >= 10.0D THEN
  60. FOR i := 1 TO 6 DO
  61. WITH Powers10[i] DO
  62. WHILE r >= pval DO
  63. r := r * rpval;
  64. INC(pointpos, exp)
  65. END;
  66. END;
  67. END;
  68. END;
  69. IF r < 1.0D THEN
  70. FOR i := 1 TO 6 DO
  71. WITH Powers10[i] DO
  72. WHILE r*pval < 10.0D DO
  73. r := r * pval;
  74. DEC(pointpos, exp)
  75. END;
  76. END;
  77. END;
  78. END;
  79. (* Now, we have r in [1.0, 10.0) *)
  80. INC(pointpos);
  81. END;
  82. ind1 := 0;
  83. ind2 := ndigits+1;
  84. IF NOT ecvtflag THEN
  85. IF INTEGER(ind2) + pointpos <= 0 THEN
  86. ind2 := 1;
  87. ELSE
  88. ind2 := INTEGER(ind2) + pointpos
  89. END;
  90. END;
  91. IF ind2 > HIGH(str) THEN
  92. ok := FALSE;
  93. str[0] := 0C;
  94. RETURN;
  95. END;
  96. WHILE ind1 < ind2 DO
  97. str[ind1] := CHR(TRUNC(r)+ORD('0'));
  98. r := 10.0D * (r - FLOATD(TRUNC(r)));
  99. INC(ind1);
  100. END;
  101. IF ind2 > 0 THEN
  102. DEC(ind2);
  103. ind1 := ind2;
  104. str[ind2] := CHR(ORD(str[ind2])+5);
  105. WHILE str[ind2] > '9' DO
  106. str[ind2] := '0';
  107. IF ind2 > 0 THEN
  108. DEC(ind2);
  109. str[ind2] := CHR(ORD(str[ind2])+1);
  110. ELSE
  111. str[ind2] := '1';
  112. INC(pointpos);
  113. IF NOT ecvtflag THEN
  114. IF ind1 > 0 THEN str[ind1] := '0'; END;
  115. INC(ind1);
  116. END;
  117. END;
  118. END;
  119. IF (NOT ecvtflag) AND (ind1 = 0) THEN
  120. str[0] := CHR(ORD(str[0])-5);
  121. INC(ind1);
  122. END;
  123. END;
  124. IF ecvtflag THEN
  125. FOR i := ind1 TO 2 BY -1 DO
  126. str[i] := str[i-1];
  127. END;
  128. str[1] := '.';
  129. INC(ind1);
  130. IF sign THEN
  131. FOR i := ind1 TO 1 BY -1 DO
  132. str[i] := str[i-1];
  133. END;
  134. INC(ind1);
  135. str[0] := '-';
  136. END;
  137. IF (ind1 + 4) > HIGH(str) THEN
  138. str[0] := 0C;
  139. ok := FALSE;
  140. RETURN;
  141. END;
  142. str[ind1] := 'E'; INC(ind1);
  143. IF arg # 0.0D THEN DEC(pointpos); END;
  144. IF pointpos < 0 THEN
  145. pointpos := -pointpos;
  146. str[ind1] := '-';
  147. ELSE
  148. str[ind1] := '+';
  149. END;
  150. INC(ind1);
  151. str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100));
  152. pointpos := pointpos MOD 100;
  153. INC(ind1);
  154. str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10));
  155. INC(ind1);
  156. str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10));
  157. ELSE
  158. IF pointpos <= 0 THEN
  159. FOR i := ind1 TO 1 BY -1 DO
  160. str[i+CARDINAL(-pointpos)] := str[i-1];
  161. END;
  162. FOR i := 0 TO CARDINAL(-pointpos) DO
  163. str[i] := '0';
  164. END;
  165. ind1 := ind1 + CARDINAL(1 - pointpos);
  166. pointpos := 1;
  167. END;
  168. FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO
  169. str[i] := str[i-1];
  170. END;
  171. IF ndigits = 0 THEN
  172. str[pointpos] := 0C;
  173. ind1 := pointpos - 1;
  174. ELSE
  175. str[pointpos] := '.';
  176. IF INTEGER(ind1) > pointpos+INTEGER(ndigits) THEN
  177. ind1 := pointpos+INTEGER(ndigits);
  178. END;
  179. str[pointpos+INTEGER(ndigits)+1] := 0C;
  180. END;
  181. IF sign THEN
  182. FOR i := ind1 TO 0 BY -1 DO
  183. str[i+1] := str[i];
  184. END;
  185. str[0] := '-';
  186. INC(ind1);
  187. END;
  188. END;
  189. IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END;
  190. IF ind1 >= CARDINAL(width) THEN
  191. ok := FALSE;
  192. RETURN;
  193. END;
  194. IF width > 0 THEN
  195. DEC(width);
  196. END;
  197. IF (width > 0) AND (ind1 < CARDINAL(width)) THEN
  198. FOR i := ind1 TO 0 BY -1 DO
  199. str[i + CARDINAL(width) - ind1] := str[i];
  200. END;
  201. FOR i := 0 TO CARDINAL(width)-(ind1+1) DO
  202. str[i] := ' ';
  203. END;
  204. ind1 := CARDINAL(width);
  205. IF (ind1+1) <= HIGH(str) THEN
  206. FOR ind1 := ind1+1 TO HIGH(str) DO
  207. str[ind1] := 0C;
  208. END;
  209. END;
  210. END;
  211. END LongRealToString;
  212. PROCEDURE StringToReal(str: ARRAY OF CHAR;
  213. VAR r: REAL; VAR ok: BOOLEAN);
  214. VAR x: LONGREAL;
  215. BEGIN
  216. StringToLongReal(str, x, ok);
  217. IF ok THEN
  218. r := x;
  219. END;
  220. END StringToReal;
  221. PROCEDURE StringToLongReal(str: ARRAY OF CHAR;
  222. VAR r: LONGREAL; VAR ok: BOOLEAN);
  223. CONST BIG = 1.0D17;
  224. TYPE SETOFCHAR = SET OF CHAR;
  225. VAR pow10 : INTEGER;
  226. i : INTEGER;
  227. e : LONGREAL;
  228. ch : CHAR;
  229. signed: BOOLEAN;
  230. signedexp: BOOLEAN;
  231. iB: CARDINAL;
  232. BEGIN
  233. r := 0.0D;
  234. pow10 := 0;
  235. iB := 0;
  236. ok := TRUE;
  237. signed := FALSE;
  238. WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO
  239. INC(iB);
  240. IF iB > HIGH(str) THEN
  241. ok := FALSE;
  242. RETURN;
  243. END;
  244. END;
  245. IF str[iB] = '-' THEN signed := TRUE; INC(iB)
  246. ELSIF str[iB] = '+' THEN INC(iB)
  247. END;
  248. ch := str[iB]; INC(iB);
  249. IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
  250. REPEAT
  251. IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r+FLOATD(ORD(ch)-ORD('0')) END;
  252. IF iB <= HIGH(str) THEN
  253. ch := str[iB]; INC(iB);
  254. END;
  255. UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
  256. IF (ch = '.') AND (iB <= HIGH(str)) THEN
  257. ch := str[iB]; INC(iB);
  258. IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
  259. REPEAT
  260. IF r < BIG THEN
  261. r := 10.0D * r + FLOATD(ORD(ch)-ORD('0'));
  262. DEC(pow10);
  263. END;
  264. IF iB <= HIGH(str) THEN
  265. ch := str[iB]; INC(iB);
  266. END;
  267. UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
  268. END;
  269. IF (ch = 'E') THEN
  270. IF iB > HIGH(str) THEN
  271. ok := FALSE;
  272. RETURN;
  273. ELSE
  274. ch := str[iB]; INC(iB);
  275. END;
  276. i := 0;
  277. signedexp := FALSE;
  278. IF (ch = '-') OR (ch = '+') THEN
  279. signedexp := ch = '-';
  280. IF iB > HIGH(str) THEN
  281. ok := FALSE;
  282. RETURN;
  283. ELSE
  284. ch := str[iB]; INC(iB);
  285. END;
  286. END;
  287. IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END;
  288. REPEAT
  289. i := i*10 + INTEGER(ORD(ch) - ORD('0'));
  290. IF iB <= HIGH(str) THEN
  291. ch := str[iB]; INC(iB);
  292. END;
  293. UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'});
  294. IF signedexp THEN i := -i END;
  295. pow10 := pow10 + i;
  296. END;
  297. IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END;
  298. e := 1.0D;
  299. DEC(i);
  300. WHILE i >= 10 DO
  301. e := e * 10000000000.0D;
  302. DEC(i,10);
  303. END;
  304. WHILE i >= 0 DO
  305. e := e * 10.0D;
  306. DEC(i)
  307. END;
  308. IF pow10<0 THEN
  309. r := r / e;
  310. ELSE
  311. r := r * e;
  312. END;
  313. IF signed THEN r := -r; END;
  314. IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END
  315. END StringToLongReal;
  316. BEGIN
  317. WITH Powers10[1] DO pval := 1.0D32; rpval := 1.0D-32; exp := 32 END;
  318. WITH Powers10[2] DO pval := 1.0D16; rpval := 1.0D-16; exp := 16 END;
  319. WITH Powers10[3] DO pval := 1.0D8; rpval := 1.0D-8; exp := 8 END;
  320. WITH Powers10[4] DO pval := 1.0D4; rpval := 1.0D-4; exp := 4 END;
  321. WITH Powers10[5] DO pval := 1.0D2; rpval := 1.0D-2; exp := 2 END;
  322. WITH Powers10[6] DO pval := 1.0D1; rpval := 1.0D-1; exp := 1 END;
  323. END RealConversions.