diff options
Diffstat (limited to 'src/grt/grt-arith.adb')
| -rw-r--r-- | src/grt/grt-arith.adb | 196 |
1 files changed, 196 insertions, 0 deletions
diff --git a/src/grt/grt-arith.adb b/src/grt/grt-arith.adb new file mode 100644 index 000000000..198ea630c --- /dev/null +++ b/src/grt/grt-arith.adb @@ -0,0 +1,196 @@ +-- GHDL Run Time (GRT) - support for exp +-- Copyright (C) 2022 Tristan Gingold +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. +-- +-- As a special exception, if other files instantiate generics from this +-- unit, or you link this unit with other files to produce an executable, +-- this unit does not by itself cause the resulting executable to be +-- covered by the GNU General Public License. This exception does not +-- however invalidate any other reasons why the executable file might be +-- covered by the GNU Public License. + +package body Grt.Arith is + function Hi (V : Ghdl_U64) return Ghdl_U32 is + begin + return Ghdl_U32 (Shift_Right (V, 32) and 16#ffff_ffff#); + end Hi; + + pragma Inline (Hi); + + function Lo (V : Ghdl_U64) return Ghdl_U32 is + begin + return Ghdl_U32 (V and 16#ffff_ffff#); + end Lo; + + pragma Inline (Lo); + + function Hi (V : Ghdl_I64) return Ghdl_U32 is + begin + return Hi (To_Ghdl_U64 (V)); + end Hi; + + function Lo (V : Ghdl_I64) return Ghdl_U32 is + begin + return Lo (To_Ghdl_U64 (V)); + end Lo; + + procedure Mul_I32_Ovf (L, R : Ghdl_I32; + Res : out Ghdl_I32; + Ovf : out Boolean) + is + T : Ghdl_I64; + begin + T := Ghdl_I64 (L) * Ghdl_I64 (R); + if Hi (T) /= Shift_Right_Arithmetic (Lo (T), 31) then + Ovf := True; + else + Ovf := False; + Res := Ghdl_I32 (T); + end if; + end Mul_I32_Ovf; + + procedure Mul_U64_Ovf (L, R : Ghdl_U64; + Res : out Ghdl_U64; + Ovf : out Boolean) + is + Ll : constant Ghdl_U32 := Lo (L); + Lh : constant Ghdl_U32 := Hi (L); + Rl : constant Ghdl_U32 := Lo (R); + Rh : constant Ghdl_U32 := Hi (R); + -- Result is: + -- Ll * Rl + -- Lh * Rl + -- Ll * Rh + -- Lh * Rh + Vll, Vhl, Vhh : Ghdl_U64; + begin + Vhh := Ghdl_U64 (Lh) * Ghdl_U64 (Rh); + if Vhh /= 0 then + Ovf := True; + return; + end if; + + -- Note: no overflow in the addition because either Rh = 0 or Lh = 0. + Vhl := Ghdl_U64 (Lh) * Ghdl_U64 (Rl) + Ghdl_U64 (Ll) * Ghdl_U64 (Rh); + + Vll := Ghdl_U64 (Ll) * Ghdl_U64 (Rl); + + Vhl := Vhl + Ghdl_U64 (Hi (Vll)); + + if Hi (Vhl) /= 0 then + Ovf := True; + else + Ovf := False; + Res := Shift_Left (Vhl, 32) or Ghdl_U64 (Lo (Vll)); + end if; + end Mul_U64_Ovf; + + procedure Exp_I64 (V : Ghdl_I64; + E : Std_Integer; + Res : out Ghdl_I64; + Ovf : out Boolean) + is + R : Std_Integer; + P : Ghdl_U64; + Ures : Ghdl_U64; + begin + if E < 0 then + Ovf := True; + return; + elsif E = 1 then + Res := V; + Ovf := False; + return; + end if; + + P := To_Ghdl_U64 (V); + if V < 0 then + -- Avoid overflow. + P := (not P) + 1; + end if; + + Ures := 1; + R := E; + loop + if R mod 2 = 1 then + Mul_U64_Ovf (Ures, P, Ures, Ovf); + if Ovf then + return; + end if; + end if; + R := R / 2; + exit when R = 0; + Mul_U64_Ovf (P, P, P, Ovf); + if Ovf then + return; + end if; + end loop; + + if V < 0 and (E mod 2) = 1 then + -- Need to negate the result. + if Shift_Right (Ures, 63) = 1 then + if Shift_Left (Ures, 1) = 0 then + Res := To_Ghdl_I64 (Ures); + Ovf := False; + else + Ovf := True; + end if; + return; + end if; + Res := To_Ghdl_I64 ((not Ures) + 1); + else + if Shift_Right (Ures, 63) = 1 then + Ovf := True; + return; + end if; + Ovf := False; + Res := To_Ghdl_I64 (Ures); + end if; + Ovf := False; + end Exp_I64; + + procedure Exp_I32 (V : Ghdl_I32; + E : Std_Integer; + Res : out Ghdl_I32; + Ovf : out Boolean) + is + R : Std_Integer; + P : Ghdl_I32; + begin + if E < 0 then + Ovf := True; + return; + end if; + + Res := 1; + P := V; + R := E; + loop + if R mod 2 = 1 then + Mul_I32_Ovf (Res, P, Res, Ovf); + if Ovf then + return; + end if; + end if; + R := R / 2; + exit when R = 0; + Mul_I32_Ovf (P, P, P, Ovf); + if Ovf then + return; + end if; + end loop; + Ovf := False; + end Exp_I32; +end Grt.Arith; |