conversions.mod 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156
  1. IMPLEMENTATION MODULE Conversions;
  2. (* Tolerant parsers report an ISO-style ConvResults code. INTEGER
  3. range is checked with a LONGINT accumulator (V3 INTEGER is 32-bit):
  4. a value outside [-2147483648, 2147483647] is strOutOfRange. *)
  5. CONST
  6. (* 32-bit INTEGER bounds (V3 INTEGER is 32-bit) *)
  7. IntMax = 2147483647;
  8. IntMin = -2147483647 - 1;
  9. PROCEDURE m2realstr(x : REAL; VAR s : ARRAY OF CHAR);
  10. EXTERNAL;
  11. PROCEDURE m2strreal(VAR s : ARRAY OF CHAR; VAR ok : INTEGER) : REAL;
  12. EXTERNAL;
  13. (* ---------------- output ---------------- *)
  14. PROCEDURE IntToStr(n : INTEGER; VAR s : ARRAY OF CHAR);
  15. VAR v : INTEGER;
  16. i, k : CARDINAL;
  17. tmp : ARRAY [0 .. 31] OF CHAR;
  18. BEGIN
  19. IF n = 0 THEN
  20. s[0] := "0"; s[1] := CHR(0)
  21. ELSE
  22. IF n < 0 THEN v := -n ELSE v := n END;
  23. i := 0;
  24. WHILE (v > 0) AND (i <= HIGH(tmp)) DO
  25. tmp[i] := CHR(ORD("0") + (v MOD 10));
  26. v := v DIV 10;
  27. INC(i)
  28. END;
  29. k := 0;
  30. IF n < 0 THEN s[k] := "-"; INC(k) END;
  31. WHILE (i > 0) AND (k <= HIGH(s)) DO
  32. DEC(i);
  33. s[k] := tmp[i]; INC(k)
  34. END;
  35. IF k <= HIGH(s) THEN s[k] := CHR(0) END
  36. END
  37. END IntToStr;
  38. PROCEDURE CardToStr(n : CARDINAL; VAR s : ARRAY OF CHAR);
  39. VAR v : CARDINAL;
  40. i, k : CARDINAL;
  41. tmp : ARRAY [0 .. 31] OF CHAR;
  42. BEGIN
  43. IF n = 0 THEN
  44. s[0] := "0"; s[1] := CHR(0)
  45. ELSE
  46. v := n; i := 0;
  47. WHILE (v > 0) AND (i <= HIGH(tmp)) DO
  48. tmp[i] := CHR(ORD("0") + (v MOD 10));
  49. v := v DIV 10;
  50. INC(i)
  51. END;
  52. k := 0;
  53. WHILE (i > 0) AND (k <= HIGH(s)) DO
  54. DEC(i);
  55. s[k] := tmp[i]; INC(k)
  56. END;
  57. IF k <= HIGH(s) THEN s[k] := CHR(0) END
  58. END
  59. END CardToStr;
  60. PROCEDURE RealToStr(x : REAL; VAR s : ARRAY OF CHAR);
  61. BEGIN
  62. m2realstr(x, s)
  63. END RealToStr;
  64. (* ---------------- input ---------------- *)
  65. PROCEDURE StrToInt(s : ARRAY OF CHAR; VAR n : INTEGER) : ConvResults;
  66. (* signed decimal. Accumulates in LONGINT (so overflow is simply a
  67. range check) then narrows with VAL(INTEGER, v). *)
  68. VAR i : CARDINAL;
  69. neg, seen : BOOLEAN;
  70. v : LONGINT;
  71. d : INTEGER;
  72. BEGIN
  73. n := 0; i := 0; neg := FALSE; seen := FALSE; v := 0;
  74. IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  75. IF s[i] = "-" THEN neg := TRUE; INC(i)
  76. ELSIF s[i] = "+" THEN INC(i)
  77. END;
  78. IF (i > HIGH(s)) OR (s[i] < "0") OR (s[i] > "9") THEN
  79. RETURN strWrongFormat
  80. END;
  81. WHILE (i <= HIGH(s)) AND (s[i] >= "0") AND (s[i] <= "9") DO
  82. d := ORD(s[i]) - ORD("0");
  83. v := v * 10 + d;
  84. seen := TRUE;
  85. INC(i)
  86. END;
  87. IF (i <= HIGH(s)) AND (s[i] # CHR(0)) THEN RETURN strWrongFormat END;
  88. IF NOT seen THEN RETURN strWrongFormat END;
  89. IF neg THEN v := 0 - v END;
  90. IF (v > IntMax) OR (v < IntMin) THEN RETURN strOutOfRange END;
  91. n := VAL(INTEGER, v);
  92. RETURN strAllRight
  93. END StrToInt;
  94. PROCEDURE StrToCard(s : ARRAY OF CHAR; VAR n : CARDINAL) : ConvResults;
  95. (* unsigned decimal; LONGINT accumulation, bounded by CARDINAL max. *)
  96. VAR i : CARDINAL;
  97. seen : BOOLEAN;
  98. v : LONGINT;
  99. d : INTEGER;
  100. BEGIN
  101. n := 0; i := 0; seen := FALSE; v := 0;
  102. IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  103. IF (s[i] < "0") OR (s[i] > "9") THEN RETURN strWrongFormat END;
  104. WHILE (i <= HIGH(s)) AND (s[i] >= "0") AND (s[i] <= "9") DO
  105. d := ORD(s[i]) - ORD("0");
  106. v := v * 10 + d;
  107. seen := TRUE;
  108. INC(i)
  109. END;
  110. IF (i <= HIGH(s)) AND (s[i] # CHR(0)) THEN RETURN strWrongFormat END;
  111. IF NOT seen THEN RETURN strWrongFormat END;
  112. IF v > IntMax THEN RETURN strOutOfRange END;
  113. n := VAL(CARDINAL, v);
  114. RETURN strAllRight
  115. END StrToCard;
  116. PROCEDURE StrToReal(VAR s : ARRAY OF CHAR; VAR x : REAL) : ConvResults;
  117. VAR i : CARDINAL;
  118. ok : INTEGER;
  119. BEGIN
  120. x := 0.0;
  121. i := 0;
  122. IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  123. x := m2strreal(s, ok);
  124. IF ok = 0 THEN RETURN strWrongFormat END;
  125. RETURN strAllRight
  126. END StrToReal;
  127. (* ---------------- BOOLEAN shortcuts ---------------- *)
  128. PROCEDURE IntVal(s : ARRAY OF CHAR; VAR n : INTEGER) : BOOLEAN;
  129. BEGIN
  130. RETURN StrToInt(s, n) = strAllRight
  131. END IntVal;
  132. PROCEDURE CardVal(s : ARRAY OF CHAR; VAR n : CARDINAL) : BOOLEAN;
  133. BEGIN
  134. RETURN StrToCard(s, n) = strAllRight
  135. END CardVal;
  136. PROCEDURE RealVal(VAR s : ARRAY OF CHAR; VAR x : REAL) : BOOLEAN;
  137. BEGIN
  138. RETURN StrToReal(s, x) = strAllRight
  139. END RealVal;
  140. END Conversions.