From 0acd1e93272e032e6e90f3c6bad39a2b5edb6b08 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 23 Oct 2018 06:41:40 +0200 Subject: ortho debug/oread: disp float number in hexa. --- src/ortho/debug/ortho_debug-disp.adb | 77 ++++++++++++- src/ortho/oread/ortho_front.adb | 209 ++++++++++++++++++++++++----------- 2 files changed, 223 insertions(+), 63 deletions(-) (limited to 'src/ortho') diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb index 8bdcce98e..a45bceca9 100644 --- a/src/ortho/debug/ortho_debug-disp.adb +++ b/src/ortho/debug/ortho_debug-disp.adb @@ -452,6 +452,81 @@ package body Ortho_Debug.Disp is end if; end Disp_Lit; + Xdigit : constant array (0 .. 15) of Character := "0123456789abcdef"; + + procedure Disp_Float_Lit + (Lit_Type : O_Tnode; Known : Boolean; Val : IEEE_Float_64) + is + pragma Assert (IEEE_Float_64'Machine_Radix = 2); + pragma Assert (IEEE_Float_64'Machine_Mantissa = 53); + Exp : Integer; + Man : Unsigned_64; + -- Res: sign(1) + 0x(2) + Man(53 / 3 ~= 18) + p(1) + sing(1) + exp(4) + Str : String (1 .. 1 + 2 + 18 + 1 + 1 + 4); + P : Natural; + Neg : Boolean; + begin + Exp := IEEE_Float_64'Exponent (Val) - 1; + Man := Unsigned_64 (abs (IEEE_Float_64'Fraction (Val)) * 2.0 ** 53); + + -- Use decimal representation if there is no digit after the dot. + if Man = 0 then + Disp_Lit (Lit_Type, Known, "0.0"); + else + pragma Assert (Shift_Right (Man, 52) = 1); + + -- Remove hidden 1. + Man := Man and (2**52 - 1); + + -- Remove trailing hex 0. + while Man /= 0 and (Man rem 16) = 0 loop + Man := Man / 16; + end loop; + + -- Exponent. + P := Str'Last; + if Exp < 0 then + Neg := True; + Exp := -Exp; + else + Neg := False; + end if; + loop + Str (P) := Xdigit (Exp rem 10); + P := P - 1; + Exp := Exp / 10; + exit when Exp = 0; + end loop; + if Neg then + Str (P) := '-'; + P := P - 1; + end if; + Str (P) := 'p'; + P := P - 1; + + -- Mantissa. + loop + Str (P) := Xdigit (Natural (Man and 15)); + P := P - 1; + Man := Man / 16; + exit when Man = 0; + end loop; + + P := P - 4; + Str (P + 1) := '0'; + Str (P + 2) := 'x'; + Str (P + 3) := '1'; + Str (P + 4) := '.'; + + if Val < 0.0 then + Str (P) := '-'; + P := P - 1; + end if; + + Disp_Lit (Lit_Type, Known, Str (P + 1 .. Str'Last)); + end if; + end Disp_Float_Lit; + -- Display C. If CTYPE is set, this is the known type of C. procedure Disp_Cnode (C : O_Cnode; Ctype : O_Tnode) is @@ -471,7 +546,7 @@ package body Ortho_Debug.Disp is when OC_Signed_Lit => Disp_Lit (C.Ctype, Known, Integer_64'Image (C.S_Val)); when OC_Float_Lit => - Disp_Lit (C.Ctype, Known, IEEE_Float_64'Image (C.F_Val)); + Disp_Float_Lit (C.Ctype, Known, C.F_Val); when OC_Boolean_Lit => -- Always disp the type of boolean literals. Disp_Lit (C.Ctype, False, Get_String (C.B_Id)); diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb index deaa5cf7d..42f72ea71 100644 --- a/src/ortho/oread/ortho_front.adb +++ b/src/ortho/oread/ortho_front.adb @@ -432,73 +432,64 @@ package body Ortho_Front is -- Previous token. Tok_Previous : Token_Type; - function Scan_Number (First_Char : Character) return Token_Type - is - function To_Digit (C : Character) return Integer is - begin - case C is - when '0' .. '9' => - return Character'Pos (C) - Character'Pos ('0'); - when 'A' .. 'F' => - return Character'Pos (C) - Character'Pos ('A') + 10; - when 'a' .. 'f' => - return Character'Pos (C) - Character'Pos ('a') + 10; - when others => - return -1; - end case; - end To_Digit; + function To_Digit (C : Character) return Integer is + begin + case C is + when '0' .. '9' => + return Character'Pos (C) - Character'Pos ('0'); + when 'A' .. 'F' => + return Character'Pos (C) - Character'Pos ('A') + 10; + when 'a' .. 'f' => + return Character'Pos (C) - Character'Pos ('a') + 10; + when others => + return -1; + end case; + end To_Digit; - function Is_Digit (C : Character) return Boolean is - begin - case C is - when '0' .. '9' - | 'A' .. 'F' - | 'a' .. 'f' => - return True; - when others => - return False; - end case; - end Is_Digit; + function Is_Digit (C : Character) return Boolean is + begin + case C is + when '0' .. '9' + | 'A' .. 'F' + | 'a' .. 'f' => + return True; + when others => + return False; + end case; + end Is_Digit; - After_Point : Integer; + function Scan_Hex_Number return Token_Type + is C : Character; Exp : Integer; Exp_Neg : Boolean; - Base : Unsigned_64; + After_Point : Natural; begin Token_Number := 0; - C := First_Char; + C := Get_Char; + if not Is_Digit (C) then + Scan_Error ("digit expected after '0x'"); + end if; loop - Token_Number := Token_Number * 10 + Unsigned_64 (To_Digit (C)); + Token_Number := Token_Number * 16 + Unsigned_64 (To_Digit (C)); C := Get_Char; exit when not Is_Digit (C); end loop; - if C = '#' then - Base := Token_Number; - Token_Number := 0; - C := Get_Char; - loop - if C /= '_' then - Token_Number := - Token_Number * Base + Unsigned_64 (To_Digit (C)); - end if; - C := Get_Char; - exit when C = '#'; - end loop; - return Tok_Num; - end if; + + After_Point := 0; if C = '.' then - -- A real number. - After_Point := 0; - Token_Float := IEEE_Float_64 (Token_Number); loop C := Get_Char; - exit when C not in '0' .. '9'; - Token_Float := Token_Float * 10.0 + IEEE_Float_64 (To_Digit (C)); - After_Point := After_Point + 1; + exit when not Is_Digit (C); + if Shift_Right (Token_Number, 60) = 0 then + Token_Number := Token_Number * 16 + Unsigned_64 (To_Digit (C)); + After_Point := After_Point + 4; + end if; end loop; - if C = 'e' or C = 'E' then - Exp := 0; + + Exp := 0; + if C = 'p' or C = 'P' then + -- A real number. C := Get_Char; Exp_Neg := False; if C = '-' then @@ -506,30 +497,124 @@ package body Ortho_Front is C := Get_Char; elsif C = '+' then C := Get_Char; - elsif not Is_Digit (C) then - Scan_Error ("digit expected"); end if; - while Is_Digit (C) loop + if not Is_Digit (C) then + Scan_Error ("digit expected after 'p'"); + end if; + loop Exp := Exp * 10 + To_Digit (C); C := Get_Char; + exit when not Is_Digit (C); end loop; if Exp_Neg then Exp := -Exp; end if; - Exp := Exp - After_Point; - else - Exp := - After_Point; end if; + Exp := Exp - After_Point; Unget_Char; - Token_Float := Token_Float * 10.0 ** Exp; - if Token_Float > IEEE_Float_64'Last then - Token_Float := IEEE_Float_64'Last; - end if; + Token_Float := + IEEE_Float_64'Scaling (IEEE_Float_64 (Token_Number), Exp); return Tok_Float_Num; else Unget_Char; return Tok_Num; end if; + end Scan_Hex_Number; + + function Scan_Fp_Number return Token_Type + is + After_Point : Integer; + C : Character; + Exp : Integer; + Exp_Neg : Boolean; + begin + -- A real number. + After_Point := 0; + Token_Float := IEEE_Float_64 (Token_Number); + loop + C := Get_Char; + exit when C not in '0' .. '9'; + Token_Float := Token_Float * 10.0 + IEEE_Float_64 (To_Digit (C)); + After_Point := After_Point + 1; + end loop; + if C = 'e' or C = 'E' then + Exp := 0; + C := Get_Char; + Exp_Neg := False; + if C = '-' then + Exp_Neg := True; + C := Get_Char; + elsif C = '+' then + C := Get_Char; + elsif not Is_Digit (C) then + Scan_Error ("digit expected"); + end if; + while Is_Digit (C) loop + Exp := Exp * 10 + To_Digit (C); + C := Get_Char; + end loop; + if Exp_Neg then + Exp := -Exp; + end if; + Exp := Exp - After_Point; + else + Exp := - After_Point; + end if; + Unget_Char; + Token_Float := Token_Float * 10.0 ** Exp; + if Token_Float > IEEE_Float_64'Last then + Token_Float := IEEE_Float_64'Last; + end if; + return Tok_Float_Num; + end Scan_Fp_Number; + + function Scan_Number (First_Char : Character) return Token_Type + is + C : Character; + Base : Unsigned_64; + begin + C := First_Char; + Token_Number := 0; + + -- Handle '0x' prefix. + if C = '0' then + -- '0' can be discarded. + C := Get_Char; + if C = 'x' or C = 'X' then + return Scan_Hex_Number; + elsif C = '.' then + return Scan_Fp_Number; + elsif not Is_Digit (C) then + Unget_Char; + return Tok_Num; + end if; + end if; + + loop + Token_Number := Token_Number * 10 + Unsigned_64 (To_Digit (C)); + C := Get_Char; + exit when not Is_Digit (C); + end loop; + if C = '#' then + Base := Token_Number; + Token_Number := 0; + C := Get_Char; + loop + if C /= '_' then + Token_Number := + Token_Number * Base + Unsigned_64 (To_Digit (C)); + end if; + C := Get_Char; + exit when C = '#'; + end loop; + return Tok_Num; + end if; + if C = '.' then + return Scan_Fp_Number; + else + Unget_Char; + return Tok_Num; + end if; end Scan_Number; procedure Scan_Comment -- cgit v1.2.3