M2compiler-V3/stdlib/conversions.mod

IMPLEMENTATION MODULE Conversions;
(* Tolerant parsers report an ISO-style ConvResults code.  INTEGER
   range is checked with a LONGINT accumulator (V3 INTEGER is 32-bit):
   a value outside [-2147483648, 2147483647] is strOutOfRange. *)

CONST
  (* 32-bit INTEGER bounds (V3 INTEGER is 32-bit) *)
  IntMax = 2147483647;
  IntMin = -2147483647 - 1;

PROCEDURE m2realstr(x : REAL; VAR s : ARRAY OF CHAR);
  EXTERNAL;

PROCEDURE m2strreal(VAR s : ARRAY OF CHAR; VAR ok : INTEGER) : REAL;
  EXTERNAL;

(* ---------------- output ---------------- *)

PROCEDURE IntToStr(n : INTEGER; VAR s : ARRAY OF CHAR);
  VAR v : INTEGER;
    i, k : CARDINAL;
    tmp : ARRAY [0 .. 31] OF CHAR;
BEGIN
  IF n = 0 THEN
    s[0] := "0"; s[1] := CHR(0)
  ELSE
    IF n < 0 THEN v := -n ELSE v := n END;
    i := 0;
    WHILE (v > 0) AND (i <= HIGH(tmp)) DO
      tmp[i] := CHR(ORD("0") + (v MOD 10));
      v := v DIV 10;
      INC(i)
    END;
    k := 0;
    IF n < 0 THEN s[k] := "-"; INC(k) END;
    WHILE (i > 0) AND (k <= HIGH(s)) DO
      DEC(i);
      s[k] := tmp[i]; INC(k)
    END;
    IF k <= HIGH(s) THEN s[k] := CHR(0) END
  END
END IntToStr;

PROCEDURE CardToStr(n : CARDINAL; VAR s : ARRAY OF CHAR);
  VAR v : CARDINAL;
    i, k : CARDINAL;
    tmp : ARRAY [0 .. 31] OF CHAR;
BEGIN
  IF n = 0 THEN
    s[0] := "0"; s[1] := CHR(0)
  ELSE
    v := n; i := 0;
    WHILE (v > 0) AND (i <= HIGH(tmp)) DO
      tmp[i] := CHR(ORD("0") + (v MOD 10));
      v := v DIV 10;
      INC(i)
    END;
    k := 0;
    WHILE (i > 0) AND (k <= HIGH(s)) DO
      DEC(i);
      s[k] := tmp[i]; INC(k)
    END;
    IF k <= HIGH(s) THEN s[k] := CHR(0) END
  END
END CardToStr;

PROCEDURE RealToStr(x : REAL; VAR s : ARRAY OF CHAR);
BEGIN
  m2realstr(x, s)
END RealToStr;

(* ---------------- input ---------------- *)

PROCEDURE StrToInt(s : ARRAY OF CHAR; VAR n : INTEGER) : ConvResults;
(* signed decimal.  V3 has no VAL(LONGINT, int) or long->int
   narrowing, so overflow is detected *before* the 32-bit accumulate
   wraps: reject when v would exceed (IntMax-d) DIV 10.  The whole
   magnitude accumulates as a non-negative INTEGER, then range is
   checked per sign. *)
  VAR i : CARDINAL;
    neg, seen, over : BOOLEAN;
    v : INTEGER;
    d : INTEGER;
    bound : INTEGER;
BEGIN
  n := 0; i := 0; neg := FALSE; seen := FALSE; v := 0;
  over := FALSE;
  IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  IF s[i] = "-" THEN neg := TRUE; INC(i)
  ELSIF s[i] = "+" THEN INC(i)
  END;
  IF (i > HIGH(s)) OR (s[i] < "0") OR (s[i] > "9") THEN
    RETURN strWrongFormat
  END;
  WHILE (i <= HIGH(s)) AND (s[i] >= "0") AND (s[i] <= "9") DO
    d := ORD(s[i]) - ORD("0");
    IF neg THEN
      (* magnitude may reach 2^31 *)
      bound := (IntMax - 1 - d) DIV 10
    ELSE
      bound := (IntMax - d) DIV 10
    END;
    IF v > bound THEN over := TRUE
    ELSE v := v * 10 + d
    END;
    seen := TRUE;
    INC(i)
  END;
  IF (i <= HIGH(s)) AND (s[i] # CHR(0)) THEN RETURN strWrongFormat END;
  IF NOT seen THEN RETURN strWrongFormat END;
  IF over THEN RETURN strOutOfRange END;
  IF neg THEN n := 0 - v ELSE n := v END;
  RETURN strAllRight
END StrToInt;

PROCEDURE StrToCard(s : ARRAY OF CHAR; VAR n : CARDINAL) : ConvResults;
(* unsigned decimal; same pre-wrap overflow guard, bounded by the
   CARDINAL max (2^32-1) held as a non-negative INTEGER magnitude. *)
  VAR i : CARDINAL;
    seen, over : BOOLEAN;
    v : INTEGER;
    d, bound : INTEGER;
BEGIN
  n := 0; i := 0; seen := FALSE; v := 0; over := FALSE;
  IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  IF (s[i] < "0") OR (s[i] > "9") THEN RETURN strWrongFormat END;
  WHILE (i <= HIGH(s)) AND (s[i] >= "0") AND (s[i] <= "9") DO
    d := ORD(s[i]) - ORD("0");
    bound := (IntMax - d) DIV 10;
    IF v > bound THEN over := TRUE
    ELSE v := v * 10 + d
    END;
    seen := TRUE;
    INC(i)
  END;
  IF (i <= HIGH(s)) AND (s[i] # CHR(0)) THEN RETURN strWrongFormat END;
  IF NOT seen THEN RETURN strWrongFormat END;
  IF over THEN RETURN strOutOfRange END;
  n := v;
  RETURN strAllRight
END StrToCard;

PROCEDURE StrToReal(VAR s : ARRAY OF CHAR; VAR x : REAL) : ConvResults;
  VAR i : CARDINAL;
    ok : INTEGER;
BEGIN
  x := 0.0;
  i := 0;
  IF (i > HIGH(s)) OR (s[i] = CHR(0)) THEN RETURN strEmpty END;
  x := m2strreal(s, ok);
  IF ok = 0 THEN RETURN strWrongFormat END;
  RETURN strAllRight
END StrToReal;

(* ---------------- BOOLEAN shortcuts ---------------- *)

PROCEDURE IntVal(s : ARRAY OF CHAR; VAR n : INTEGER) : BOOLEAN;
BEGIN
  RETURN StrToInt(s, n) = strAllRight
END IntVal;

PROCEDURE CardVal(s : ARRAY OF CHAR; VAR n : CARDINAL) : BOOLEAN;
BEGIN
  RETURN StrToCard(s, n) = strAllRight
END CardVal;

PROCEDURE RealVal(VAR s : ARRAY OF CHAR; VAR x : REAL) : BOOLEAN;
BEGIN
  RETURN StrToReal(s, x) = strAllRight
END RealVal;

END Conversions.