diff options
Diffstat (limited to 'src/grt/grt-to_strings.adb')
-rw-r--r-- | src/grt/grt-to_strings.adb | 364 |
1 files changed, 364 insertions, 0 deletions
diff --git a/src/grt/grt-to_strings.adb b/src/grt/grt-to_strings.adb index 0a982b5e2..8b821ae0b 100644 --- a/src/grt/grt-to_strings.adb +++ b/src/grt/grt-to_strings.adb @@ -145,4 +145,368 @@ package body Grt.To_Strings is end if; First := P; end To_String; + + NBSP : constant Character := Character'Val (160); + HT : constant Character := Character'Val (9); + + -- Convert S (INIT_POS .. LEN) to a signed integer. + function Value_I64 (S : Std_String_Basep; + Len : Ghdl_Index_Type; + Init_Pos : Ghdl_Index_Type) return Value_I64_Result + is + Pos : Ghdl_Index_Type := Init_Pos; + C : Character; + Sep : Character; + Val, D, Base : Ghdl_I64; + Exp : Integer; + Is_Neg : Boolean; + begin + C := S (Pos); + Val := 0; + + -- LRM02 14.1 Predefined attributes + -- Restrictions: It is an error is the parameter is not a valid string + -- representation of a literal ot type T. + -- + -- Apparently there is no definition of 'string representation', the + -- closest is: + -- + -- LRM02 14.3 Package TEXTIO + -- The representation of both INTEGER and REAL values [...] + Is_Neg := False; + if C = '+' or C = '-' then + if Pos = Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + Pos := Pos + 1; + Is_Neg := C = '-'; + C := S (Pos); + end if; + + loop + if C in '0' .. '9' then + Val := Val * 10 - (Character'Pos (C) - Character'Pos ('0')); + Pos := Pos + 1; + exit when Pos >= Len; + C := S (Pos); + else + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + case C is + when '_' => + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_Underscore, Pos => Pos); + end if; + C := S (Pos); + when '#' + | ':' + | 'E' + | 'e' => + exit; + when ' ' + | NBSP + | HT => + Pos := Pos + 1; + exit; + when others => + null; + end case; + end loop; + + if Pos >= Len then + if not Is_Neg then + Val := -Val; + end if; + return (Status => Value_Ok, Val => Val); + end if; + + if C = '#' or C = ':' then + Base := -Val; + Val := 0; + Sep := C; + Pos := Pos + 1; + if Base < 2 or Base > 16 then + return (Status => Value_Err_Bad_Base, Pos => Pos); + end if; + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + C := S (Pos); + loop + case C is + when '0' .. '9' => + D := Character'Pos (C) - Character'Pos ('0'); + when 'a' .. 'f' => + D := Character'Pos (C) - Character'Pos ('a') + 10; + when 'A' .. 'F' => + D := Character'Pos (C) - Character'Pos ('A') + 10; + when others => + return (Status => Value_Err_Bad_Digit, Pos => Pos); + end case; + if D >= Base then + return (Status => Value_Err_Bad_Digit, Pos => Pos); + end if; + Val := Val * Base - D; + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_Bad_End_Sign, Pos => Pos); + end if; + C := S (Pos); + if C = '#' or C = ':' then + if C /= Sep then + return (Status => Value_Err_Bad_End_Sign, Pos => Pos); + end if; + Pos := Pos + 1; + exit; + elsif C = '_' then + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_Underscore, Pos => Pos); + end if; + C := S (Pos); + end if; + end loop; + else + Base := 10; + end if; + + -- Handle exponent. + if C = 'e' or C = 'E' then + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + C := S (Pos); + if C = '+' then + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + C := S (Pos); + elsif C = '-' then + return (Status => Value_Err_Bad_Exponent, Pos => Pos); + end if; + Exp := 0; + loop + if C in '0' .. '9' then + Exp := Exp * 10 + Character'Pos (C) - Character'Pos ('0'); + Pos := Pos + 1; + exit when Pos >= Len; + C := S (Pos); + else + return (Status => Value_Err_Bad_Digit, Pos => Pos); + end if; + case C is + when '_' => + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_Underscore, Pos => Pos); + end if; + C := S (Pos); + when ' ' + | NBSP + | HT => + Pos := Pos + 1; + exit; + when others => + null; + end case; + end loop; + while Exp > 0 loop + if Exp mod 2 = 1 then + Val := Val * Base; + end if; + Exp := Exp / 2; + Base := Base * Base; + end loop; + end if; + + if Pos /= Len then + return (Status => Value_Err_Trailing_Chars, Pos => Pos); + end if; + + if not Is_Neg then + Val := -Val; + end if; + + return (Status => Value_Ok, Val => Val); + end Value_I64; + + -- From patch attached to https://gna.org/bugs/index.php?18352 + -- thanks to Christophe Curis https://gna.org/users/lobotomy + function Value_F64 (S : Std_String_Basep; + Len : Ghdl_Index_Type; + Init_Pos : Ghdl_Index_Type) return Value_F64_Result + is + Pos : Ghdl_Index_Type := Init_Pos; + C : Character; + Is_Negative, Is_Neg_Exp : Boolean := False; + Base : Ghdl_F64; + Intg : Ghdl_I32; + Val, Df : Ghdl_F64; + Sep : Character; + FrcExp : Ghdl_F64; + begin + C := S (Pos); + if C = '-' then + Is_Negative := True; + Pos := Pos + 1; + elsif C = '+' then + Pos := Pos + 1; + end if; + + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + + -- Read Integer-or-Base part (may be optional) + Intg := 0; + while Pos < Len loop + C := S (Pos); + if C in '0' .. '9' then + Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0'); + elsif C /= '_' then + exit; + end if; + Pos := Pos + 1; + end loop; + + if Pos = Len then + return (Status => Value_Ok, Val => Ghdl_F64 (Intg)); + end if; + + -- Special case: base was specified + if C = '#' or C = ':' then + if Intg < 2 or Intg > 16 then + return (Status => Value_Err_Bad_Base, Pos => Pos); + end if; + Base := Ghdl_F64 (Intg); + Val := 0.0; + Sep := C; + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + + -- Get the Integer part of the Value + while Pos < Len loop + C := S (Pos); + case C is + when '0' .. '9' => + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0') ); + when 'A' .. 'F' => + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10); + when 'a' .. 'f' => + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10); + when others => + exit; + end case; + if C /= '_' then + if Df >= Base then + return (Status => Value_Err_Bad_Digit, Pos => Pos); + end if; + Val := Val * Base + Df; + end if; + Pos := Pos + 1; + end loop; + if Pos >= Len then + return (Status => Value_Err_Bad_End_Sign, Pos => Pos); + end if; + else + Base := 10.0; + Sep := ' '; + Val := Ghdl_F64 (Intg); + end if; + + -- Handle the Fractional part + if C = '.' then + Pos := Pos + 1; + FrcExp := 1.0; + while Pos < Len loop + C := S (Pos); + case C is + when '0' .. '9' => + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('0')); + when 'A' .. 'F' => + exit when Sep = ' '; + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('A') + 10); + when 'a' .. 'f' => + exit when Sep = ' '; + Df := Ghdl_F64 (Character'Pos (C) - Character'Pos('a') + 10); + when others => + exit; + end case; + if C /= '_' then + FrcExp := FrcExp / Base; + if Df > Base then + return (Status => Value_Err_Bad_Digit, Pos => Pos); + end if; + Val := Val + Df * FrcExp; + end if; + Pos := Pos + 1; + end loop; + end if; + + -- If base was specified, we must find here the end marker + if Sep /= ' ' then + if Pos >= Len or else C /= Sep then + return (Status => Value_Err_Bad_End_Sign, Pos => Pos); + end if; + Pos := Pos + 1; + end if; + + -- Handle exponent + if Pos < Len then + C := S (Pos); + if C = 'e' or C = 'E' then + Pos := Pos + 1; + if Pos >= Len then + return (Status => Value_Err_No_Digit, Pos => Pos); + end if; + C := S (Pos); + if C = '-' then + Is_Neg_Exp := True; + Pos := Pos + 1; + elsif C = '+' then + Pos := Pos + 1; + end if; + Intg := 0; + while Pos < Len loop + C := S (Pos); + if C in '0' .. '9' then + Intg := Intg * 10 + Character'Pos (C) - Character'Pos ('0'); + else + exit; + end if; + Pos := Pos + 1; + end loop; + -- This Exponentiation method is sub-optimal, + -- but it does not depend on any library + FrcExp := 1.0; + if Is_Neg_Exp then + while Intg > 0 loop + FrcExp := FrcExp / 10.0; + Intg := Intg - 1; + end loop; + else + while Intg > 0 loop + FrcExp := FrcExp * 10.0; + Intg := Intg - 1; + end loop; + end if; + Val := Val * FrcExp; + end if; + end if; + + if Pos /= Len then + return (Status => Value_Err_Trailing_Chars, Pos => Pos); + end if; + + if Is_Negative then + Val := -Val; + end if; + + return (Status => Value_Ok, Val => Val); + end Value_F64; end Grt.To_Strings; |