mirror of
https://github.com/AdaCore/PolyORB.git
synced 2026-02-12 13:01:15 -08:00
158 lines
6.0 KiB
Ada
158 lines
6.0 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- POLYORB COMPONENTS --
|
|
-- --
|
|
-- V A L U E S --
|
|
-- --
|
|
-- S p e c --
|
|
-- --
|
|
-- Copyright (C) 2005-2012, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- This is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. This software is distributed in the hope that it will be useful, --
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
|
|
-- TABILITY 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 and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- PolyORB is maintained by AdaCore --
|
|
-- (email: sales@adacore.com) --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Types; use Types;
|
|
|
|
with Frontend.Nodes; use Frontend.Nodes;
|
|
|
|
package Values is
|
|
|
|
type Value_Type (K : Node_Kind := K_Float) is
|
|
record
|
|
case K is
|
|
when K_Short .. K_Unsigned_Long_Long
|
|
| K_Octet
|
|
| K_Boolean
|
|
| K_Fixed_Point_Type =>
|
|
IVal : Unsigned_Long_Long;
|
|
Sign : Short_Short;
|
|
case K is
|
|
when K_Fixed_Point_Type =>
|
|
Total : Unsigned_Short_Short;
|
|
Scale : Unsigned_Short_Short;
|
|
when others =>
|
|
Base : Unsigned_Short_Short;
|
|
end case;
|
|
|
|
when K_Float .. K_Long_Double =>
|
|
FVal : Long_Double;
|
|
|
|
when K_Char .. K_Wide_Char =>
|
|
CVal : Unsigned_Short;
|
|
|
|
when K_String .. K_Wide_String
|
|
| K_Enumerator =>
|
|
SVal : Name_Id;
|
|
case K is
|
|
when K_Enumerator =>
|
|
Pos : Unsigned_Long_Long;
|
|
when others =>
|
|
null;
|
|
end case;
|
|
|
|
when K_Void =>
|
|
null;
|
|
|
|
when others =>
|
|
null;
|
|
end case;
|
|
end record;
|
|
|
|
Bad_Value : constant Value_Type;
|
|
No_Value : constant Value_Id;
|
|
|
|
function New_Boolean_Value
|
|
(Value : Boolean) return Value_Id;
|
|
|
|
function New_Character_Value
|
|
(Value : Unsigned_Short;
|
|
Wide : Boolean) return Value_Id;
|
|
|
|
function New_Enumerator
|
|
(Img : Name_Id;
|
|
Pos : Unsigned_Long_Long) return Value_Id;
|
|
|
|
function New_Fixed_Point_Value
|
|
(Value : Unsigned_Long_Long;
|
|
Sign : Short_Short;
|
|
Total : Unsigned_Short_Short;
|
|
Scale : Unsigned_Short_Short) return Value_Id;
|
|
|
|
function New_Floating_Point_Value
|
|
(Value : Long_Double) return Value_Id;
|
|
|
|
function New_Integer_Value
|
|
(Value : Unsigned_Long_Long;
|
|
Sign : Short_Short;
|
|
Base : Unsigned_Short_Short) return Value_Id;
|
|
|
|
function New_String_Value
|
|
(Value : Name_Id;
|
|
Wide : Boolean) return Value_Id;
|
|
|
|
function New_Value
|
|
(Value : Value_Type) return Value_Id;
|
|
|
|
function Convert (V : Value_Type; K : Node_Kind) return Value_Type;
|
|
|
|
Max_Digits : constant := 31;
|
|
|
|
procedure Normalize_Fixed_Point_Value
|
|
(Value : in out Value_Id;
|
|
Total : Unsigned_Short_Short := Max_Digits;
|
|
Scale : Unsigned_Short_Short := Max_Digits);
|
|
|
|
procedure Normalize_Fixed_Point_Value
|
|
(Value : in out Value_Type;
|
|
Total : Unsigned_Short_Short := Max_Digits;
|
|
Scale : Unsigned_Short_Short := Max_Digits);
|
|
|
|
function Value (V : Value_Id) return Value_Type;
|
|
procedure Set_Value (V : Value_Id; X : Value_Type);
|
|
|
|
function Image (Value : Value_Id) return String;
|
|
function Image_Ada (Value : Value_Id) return String;
|
|
|
|
function "not" (R : Value_Type) return Value_Type;
|
|
function "-" (R : Value_Type) return Value_Type;
|
|
function "-" (L, R : Value_Type) return Value_Type;
|
|
function "+" (L, R : Value_Type) return Value_Type;
|
|
function "mod" (L, R : Value_Type) return Value_Type;
|
|
function "/" (L, R : Value_Type) return Value_Type;
|
|
function "*" (L, R : Value_Type) return Value_Type;
|
|
function "and" (L, R : Value_Type) return Value_Type;
|
|
function "or" (L, R : Value_Type) return Value_Type;
|
|
function "xor" (L, R : Value_Type) return Value_Type;
|
|
function Shift_Left (L, R : Value_Type) return Value_Type;
|
|
function Shift_Right (L, R : Value_Type) return Value_Type;
|
|
|
|
function "<" (L, R : Value_Type) return Boolean;
|
|
-- Assume L and R have the same type.
|
|
|
|
function Negative (V : Value_Type) return Boolean;
|
|
function Negative (V : Value_Id) return Boolean;
|
|
-- Return True when R is a strictly negative number. Raise an exception if
|
|
-- if R is not a number.
|
|
|
|
private
|
|
|
|
Bad_Value : constant Value_Type := Value_Type'((K => K_Void));
|
|
No_Value : constant Value_Id := 0;
|
|
|
|
end Values;
|