(* Copyright (C) 1990, Digital Equipment Corporation. *) (* All rights reserved. *) (* See the file COPYRIGHT for a full description. *) (* Last modified on Thu May 17 01:58:23 1990 by muller *) (* modified on Thu Dec 21 11:38:29 1989 by kalsow *) UNSAFE MODULE Convert; IMPORT Word; FROM CConvert IMPORT sprintf, strtod; VAR Digits := ARRAY [0..15] OF CHAR { '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' }; PROCEDURE FromInt (VAR buf : Buffer; value : INTEGER; base : Base := 10; prefix : BOOLEAN := FALSE): INTEGER RAISES {Failed} = VAR nDigits : INTEGER := 0; minus : BOOLEAN := FALSE; bump : BOOLEAN := FALSE; i, j : INTEGER; c : CHAR; result : ARRAY [0..BITSIZE (INTEGER)] OF CHAR; BEGIN IF (value = 0) THEN result[0] := '0'; nDigits := 1; ELSE (* handle a non-zero number *) (* get rid of negative numbers *) IF (value < 0) THEN IF (value = FIRST (INTEGER)) THEN (* 2's complement makes FIRST(INTEGER) a special case *) bump := TRUE; INC (value); END; minus := TRUE; value := -value; <* ASSERT value > 0 *> END; (* convert the bulk of the digits *) WHILE (value > 0) DO result [nDigits] := Digits [value MOD base]; value := value DIV base; INC (nDigits); END; (* fixup FIRST (INTEGER) *) IF (bump) THEN result [nDigits] := '0'; j := 0; LOOP c := result [j]; IF (c <= '9') THEN i := ORD (c) - ORD ('0'); ELSE i := ORD (c) - ORD ('a') + 10; END; INC (i); IF (i < base) THEN result [j] := Digits [i]; EXIT END; result [j] := '0'; INC (j); END; nDigits := MAX (nDigits, j+1); END; END; (* make sure we've got room for the result *) j := nDigits; IF minus THEN INC (j) END; IF prefix THEN IF base > 9 THEN INC (j, 3) ELSE INC (j, 2) END END; IF (j > NUMBER (buf)) THEN RAISE Failed END; (* build the result buffer *) j := 0; IF (minus) THEN buf [0] := '-'; j := 1; END; IF (prefix) THEN IF (base > 9) THEN buf[j] := '1'; INC (j); END; buf[j] := Digits [base MOD 10]; INC (j); buf[j] := '_'; INC (j); END; FOR k := nDigits-1 TO 0 BY -1 DO buf [j] := result [k]; INC (j); END; RETURN j; END FromInt; PROCEDURE FromUnsigned (VAR buf : Buffer; value : INTEGER; base : Base := 10; prefix : BOOLEAN := FALSE): INTEGER RAISES{Failed}= VAR nDigits : INTEGER := 0; j : INTEGER; result : ARRAY [0..BITSIZE (INTEGER)] OF CHAR; BEGIN IF (value = 0) THEN result[0] := '0'; nDigits := 1; ELSE (* convert the bulk of the digits *) WHILE (value # 0) DO result [nDigits] := Digits [Word.Mod (value, base)]; value := Word.Divide (value, base); INC (nDigits); END; END; (* make sure we've got room for the result *) j := nDigits; IF (prefix) THEN IF base > 9 THEN INC (j, 3) ELSE INC (j, 2) END END; IF (j > NUMBER (buf)) THEN RAISE Failed END; (* build the result buffer *) j := 0; IF (prefix) THEN IF (base > 9) THEN buf[j] := '1'; INC (j); END; buf[j] := Digits [base MOD 10]; INC (j); buf[j] := '_'; INC (j); END; FOR k := nDigits-1 TO 0 BY -1 DO buf [j] := result [k]; INC (j); END; RETURN j; END FromUnsigned; PROCEDURE FromFloat (VAR buf : Buffer; v : REAL; p : INTEGER := 6; style := Style.Mix): INTEGER RAISES {Failed} = BEGIN RETURN InternalFromLongFloat (buf, LONGFLOAT (v), p, style, 'E'); END FromFloat; PROCEDURE FromLongFloat (VAR buf : Buffer; v : LONGREAL; p : INTEGER := 6; style := Style.Mix): INTEGER RAISES {Failed} = BEGIN RETURN InternalFromLongFloat (buf, v, p, style, 'D'); END FromLongFloat; PROCEDURE InternalFromLongFloat (VAR buf : Buffer; v : LONGREAL; p : INTEGER := 6; style := Style.Mix; c : CHAR): INTEGER RAISES {Failed} = TYPE Fmt = ARRAY [0..5] OF CHAR; VAR (* we need to take the address of these strings *) SciFmt := Fmt { '%', '#', '.', '*', 'e', '\000'}; FloFmt := Fmt { '%', '#', '.', '*', 'f', '\000'}; MixFmt := Fmt { '%', '.', '*', 'g', '\000', '\000'}; VAR chars : ARRAY [0..100] OF CHAR; len : CARDINAL := 0; i, j : CARDINAL := 0; a : ADDRESS := ADR (chars [0]); BEGIN CASE style OF | Style.Flo => IF sprintf (a, ADR (FloFmt [0]), p, v) # a THEN RAISE Failed; END; WHILE chars[len] # '\000' DO INC (len); END; | Style.AltFlo => IF sprintf (a, ADR (FloFmt [0]), p, v) # a THEN RAISE Failed; END; WHILE chars[i] # '\000' DO INC (i); END; DEC (i); WHILE chars[i] = '0' DO DEC (i); END; len := i + 1; | Style.Sci => IF sprintf (a, ADR (SciFmt [0]), p, v) # a THEN RAISE Failed; END; WHILE chars[len] # 'e' DO INC (len); END; chars[len] := c; WHILE chars[len] # '\000' DO INC (len); END; | Style.AltSci => IF sprintf (a, ADR (SciFmt [0]), p, v) # a THEN RAISE Failed; END; WHILE chars[i] # 'e' DO INC (i); END; chars[i] := c; j := i - 1; WHILE chars[j] = '0' DO DEC (j); END; INC (j); WHILE chars[i] # '\000' DO chars[j] := chars[i]; INC (i); INC (j); END; len := j; | Style.Mix => IF sprintf (a, ADR (MixFmt [0]), p, v) # a THEN RAISE Failed; END; WHILE (chars [len] # 'e') AND (chars [len] # '\000') DO INC (len); END; IF chars [len] = 'e' THEN chars [len] := c; WHILE chars[len] # '\000' DO INC (len); END; END; END; IF len > NUMBER (buf) THEN RAISE Failed; END; FOR i := 0 TO len - 1 DO buf[i] := chars[i]; END; RETURN (len); END InternalFromLongFloat; PROCEDURE ToInt (READONLY buf : Buffer; VAR used : INTEGER; base : Base := 10): INTEGER RAISES {} = VAR value : LONGREAL := 0.0d+0; (* accumulated value *) sign : LONGREAL := 1.0d+0; limit : LONGREAL := LONGFLOAT (LAST (INTEGER)); n : INTEGER := 0; (* index of current digit *) z : INTEGER := NUMBER (buf); val2 : LONGREAL; rbase : LONGREAL; ibase : INTEGER; based : BOOLEAN; i, j : INTEGER; c : CHAR; BEGIN IF (n >= z) THEN used := 0; RETURN 0 END; c := buf[n]; (* check for signs *) IF (c = '-') THEN sign := -1.0d+0; limit := - LONGFLOAT (FIRST (INTEGER)); INC (n); IF (n >= z) THEN used := 0; RETURN 0 END; c := buf[n]; ELSIF (c = '+') THEN INC (n); IF (n >= z) THEN used := 0; RETURN 0 END; c := buf[n]; END; (* peel off any leading zeros *) WHILE (c = '0') DO INC (n); IF (n >= z) THEN used := n; RETURN 0 END; c := buf[n]; END; (* check for an explicit base *) IF (c = '1') AND (n+3 < z) AND (buf[n+2] = '_') AND ('0' <= buf[n+1]) AND (buf[n+1] <= '6') THEN (* an explicit base between 10 and 16 *) based := TRUE; ibase := 10 + ORD (buf[n+1]) - ORD ('0'); INC (n, 3); c := buf[n]; ELSIF ('2' <= c) AND (c <= '9') AND (n+2 < z) AND (buf[n+1] = '_') THEN (* an explicit base between 2 and 9 *) based := TRUE; ibase := ORD (c) - ORD ('0'); INC (n, 2); c := buf[n]; ELSE (* no explicit base *) based := FALSE; ibase := base; END; rbase := LONGFLOAT (ibase); (* scan the digits *) j := n; (* remember the first digit *) LOOP IF ('0' <= c) AND (c <= '9') THEN i := ORD (c) - ORD ('0'); ELSIF ('A' <= c) AND (c <= 'F') THEN i := ORD (c) - ORD ('A') + 10; ELSIF ('a' <= c) AND (c <= 'f') THEN i := ORD (c) - ORD ('a') + 10; ELSE EXIT; END; IF (i >= ibase) THEN EXIT END; val2 := value * rbase + LONGFLOAT (i); IF (val2 > limit) THEN EXIT END; value := val2; INC (n); IF (n >= z) THEN EXIT END; c := buf [n]; END; IF (j = n) AND (based) THEN (* no digits were consumed *) (* back up and "rescan" the explicit base *) IF (ibase < 10) THEN (* single digit base was specified *) DEC (n); (* return the "_" *) IF (ibase < base) THEN (* digit is legal *) value := LONGFLOAT (ibase); ELSE (* an illegal digit was specified *) DEC (n); (* return the digit *) (* value remains 0 *) END; ELSE (* 2-digit base was specified *) (* first digit was '1' and is always legal *) DEC (n); (* return the "_" *) IF (ibase-10 < base) THEN (* the second digit was legal *) value := LONGFLOAT (base + ibase-10); ELSE (* the second digit was illegal *) DEC (n); (* return the second digit *) value := LONGFLOAT (base); END; END; END; (* return the value *) used := n; RETURN TRUNC (sign * value); END ToInt; PROCEDURE ToUnsigned (READONLY buf : Buffer; VAR used : INTEGER; base : Base := 10): INTEGER RAISES {} = CONST lastint = LONGFLOAT (LAST (INTEGER)); limit = 2.0d0 * lastint + 1.0d0; VAR value : LONGREAL := 0.0d+0; (* accumulated value *) n : INTEGER := 0; (* index of current digit *) z : INTEGER := NUMBER (buf); val2 : LONGREAL; rbase : LONGREAL; ibase : INTEGER; based : BOOLEAN; i, j : INTEGER; c : CHAR; BEGIN IF (n >= z) THEN used := n; RETURN 0 END; c := buf[n]; (* check for signs *) IF (c = '+') THEN INC (n); IF (n >= z) THEN used := 0; RETURN 0 END; c := buf[n]; END; (* peel off any leading zeros *) WHILE (c = '0') DO INC (n); IF (n >= z) THEN used := n; RETURN 0 END; c := buf[n]; END; (* check for an explicit base *) IF (c = '1') AND (n+3 < z) AND (buf[n+2] = '_') AND ('0' <= buf[n+1]) AND (buf[n+1] <= '6') THEN (* an explicit base between 10 and 16 *) based := TRUE; ibase := 10 + ORD (buf[n+1]) - ORD ('0'); INC (n, 3); c := buf[n]; ELSIF ('2' <= c) AND (c <= '9') AND (n+2 < z) AND (buf[n+1] = '_') THEN (* an explicit base between 2 and 9 *) based := TRUE; ibase := ORD (c) - ORD ('0'); INC (n, 2); c := buf[n]; ELSE (* no explicit base *) based := FALSE; ibase := base; END; rbase := LONGFLOAT (ibase); j := n; (* remember the first digit *) LOOP IF ('0' <= c) AND (c <= '9') THEN i := ORD (c) - ORD ('0'); ELSIF ('A' <= c) AND (c <= 'F') THEN i := ORD (c) - ORD ('A') + 10; ELSIF ('a' <= c) AND (c <= 'f') THEN i := ORD (c) - ORD ('a') + 10; ELSE EXIT; END; IF (i >= ibase) THEN EXIT END; val2 := value * rbase + LONGFLOAT (i); IF (val2 > limit) THEN EXIT END; value := val2; INC (n); IF (n >= z) THEN EXIT END; c := buf [n]; END; IF (j = n) AND (based) THEN (* no digits were consumed *) (* back up and "rescan" the explicit base *) IF (ibase < 10) THEN (* single digit base was specified *) DEC (n); (* return the "_" *) IF (ibase < base) THEN (* digit is legal *) value := LONGFLOAT (ibase); ELSE (* an illegal digit was specified *) DEC (n); (* return the digit *) (* value remains 0 *) END; ELSE (* 2-digit base was specified *) (* first digit was '1' and is always legal *) DEC (n); (* return the "_" *) IF (ibase-10 < base) THEN (* the second digit was legal *) value := LONGFLOAT (base + ibase-10); ELSE (* the second digit was illegal *) DEC (n); (* return the second digit *) value := LONGFLOAT (base); END; END; END; (* return the value *) used := n; IF (value > lastint) THEN value := value - (lastint + 1.0d0 - LONGFLOAT (FIRST (INTEGER))); END; RETURN TRUNC (value); END ToUnsigned; PROCEDURE ToFloat (READONLY buf : Buffer; VAR used : INTEGER): REAL RAISES {Failed} = VAR eptr: ADDRESS; value: LONGREAL; chars: UNTRACED REF ARRAY OF CHAR; nchars: INTEGER := NUMBER (buf); BEGIN (* buf does not need to be terminated by a \0, so we have to copy the characters in a local array. *) chars := NEW (UNTRACED REF ARRAY OF CHAR, nchars + 1); FOR i := 0 TO nchars -1 DO chars[i] := buf[i]; END; chars[nchars] := '\000'; FOR i := 0 TO nchars - 1 DO IF chars[i] = 'E' THEN chars [i] := 'e'; EXIT; END; END; value := strtod (ADR (chars [0]), eptr); IF eptr = LOOPHOLE (0, ADDRESS) THEN DISPOSE (chars); RAISE Failed; ELSE used := eptr - ADR (chars [0]); DISPOSE (chars); RETURN FLOAT (value); END; END ToFloat; PROCEDURE ToLongFloat (READONLY buf : Buffer; VAR used : INTEGER): LONGREAL RAISES {Failed} = VAR eptr: ADDRESS; value: LONGREAL; chars: UNTRACED REF ARRAY OF CHAR; nchars: INTEGER := NUMBER (buf); BEGIN (* buf does not need to be terminated by a \0, so we have to copy the characters in a local array. *) chars := NEW (UNTRACED REF ARRAY OF CHAR, nchars + 1); FOR i := 0 TO nchars - 1 DO chars[i] := buf[i]; END; chars[nchars] := '\000'; FOR i := 0 TO nchars - 1 DO IF chars[i] = 'D' OR chars[i] = 'd' THEN chars [i] := 'e'; EXIT; END; END; value := strtod (ADR (chars [0]), eptr); IF eptr = LOOPHOLE (0, ADDRESS) THEN DISPOSE (chars); RAISE Failed; ELSE used := eptr - ADR (chars [0]); DISPOSE (chars); RETURN value; END; END ToLongFloat; BEGIN END Convert.