OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [sem_vfpt.adb] - Blame information for rev 717

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                             S E M _ V F P T                              --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 1997-2010, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with CStand;   use CStand;
27
with Einfo;    use Einfo;
28
with Opt;      use Opt;
29
with Stand;    use Stand;
30
with Targparm; use Targparm;
31
 
32
package body Sem_VFpt is
33
 
34
   -----------------
35
   -- Set_D_Float --
36
   -----------------
37
 
38
   procedure Set_D_Float (E : Entity_Id) is
39
      VAXDF_Digits : constant := 9;
40
 
41
   begin
42
      Init_Size         (Base_Type (E), 64);
43
      Init_Alignment    (Base_Type (E));
44
      Init_Digits_Value (Base_Type (E), VAXDF_Digits);
45
      Set_Float_Rep     (Base_Type (E), VAX_Native);
46
      Set_Float_Bounds  (Base_Type (E));
47
 
48
      Init_Size         (E, 64);
49
      Init_Alignment    (E);
50
      Init_Digits_Value (E, VAXDF_Digits);
51
      Set_Scalar_Range  (E, Scalar_Range (Base_Type (E)));
52
   end Set_D_Float;
53
 
54
   -----------------
55
   -- Set_F_Float --
56
   -----------------
57
 
58
   procedure Set_F_Float (E : Entity_Id) is
59
      VAXFF_Digits : constant := 6;
60
 
61
   begin
62
      Init_Size         (Base_Type (E), 32);
63
      Init_Alignment    (Base_Type (E));
64
      Init_Digits_Value (Base_Type (E), VAXFF_Digits);
65
      Set_Float_Rep     (Base_Type (E), VAX_Native);
66
      Set_Float_Bounds  (Base_Type (E));
67
 
68
      Init_Size         (E, 32);
69
      Init_Alignment    (E);
70
      Init_Digits_Value (E, VAXFF_Digits);
71
      Set_Scalar_Range  (E, Scalar_Range (Base_Type (E)));
72
   end Set_F_Float;
73
 
74
   -----------------
75
   -- Set_G_Float --
76
   -----------------
77
 
78
   procedure Set_G_Float (E : Entity_Id) is
79
      VAXGF_Digits : constant := 15;
80
 
81
   begin
82
      Init_Size         (Base_Type (E), 64);
83
      Init_Alignment    (Base_Type (E));
84
      Init_Digits_Value (Base_Type (E), VAXGF_Digits);
85
      Set_Float_Rep     (Base_Type (E), VAX_Native);
86
      Set_Float_Bounds  (Base_Type (E));
87
 
88
      Init_Size         (E, 64);
89
      Init_Alignment    (E);
90
      Init_Digits_Value (E, VAXGF_Digits);
91
      Set_Scalar_Range  (E, Scalar_Range (Base_Type (E)));
92
   end Set_G_Float;
93
 
94
   -------------------
95
   -- Set_IEEE_Long --
96
   -------------------
97
 
98
   procedure Set_IEEE_Long (E : Entity_Id) is
99
      IEEEL_Digits : constant := 15;
100
 
101
   begin
102
      Init_Size         (Base_Type (E), 64);
103
      Init_Alignment    (Base_Type (E));
104
      Init_Digits_Value (Base_Type (E), IEEEL_Digits);
105
      Set_Float_Rep     (Base_Type (E), IEEE_Binary);
106
      Set_Float_Bounds  (Base_Type (E));
107
 
108
      Init_Size         (E, 64);
109
      Init_Alignment    (E);
110
      Init_Digits_Value (E, IEEEL_Digits);
111
      Set_Scalar_Range  (E, Scalar_Range (Base_Type (E)));
112
   end Set_IEEE_Long;
113
 
114
   --------------------
115
   -- Set_IEEE_Short --
116
   --------------------
117
 
118
   procedure Set_IEEE_Short (E : Entity_Id) is
119
      IEEES_Digits : constant := 6;
120
 
121
   begin
122
      Init_Size         (Base_Type (E), 32);
123
      Init_Alignment    (Base_Type (E));
124
      Init_Digits_Value (Base_Type (E), IEEES_Digits);
125
      Set_Float_Rep     (Base_Type (E), IEEE_Binary);
126
      Set_Float_Bounds  (Base_Type (E));
127
 
128
      Init_Size         (E, 32);
129
      Init_Alignment    (E);
130
      Init_Digits_Value (E, IEEES_Digits);
131
      Set_Scalar_Range  (E, Scalar_Range (Base_Type (E)));
132
   end Set_IEEE_Short;
133
 
134
   ------------------------------
135
   -- Set_Standard_Fpt_Formats --
136
   ------------------------------
137
 
138
   procedure Set_Standard_Fpt_Formats is
139
   begin
140
      --  IEEE case
141
 
142
      if Opt.Float_Format = 'I' then
143
         Set_IEEE_Short (Standard_Float);
144
         Set_IEEE_Long  (Standard_Long_Float);
145
         Set_IEEE_Long  (Standard_Long_Long_Float);
146
 
147
      --  Vax float case
148
 
149
      else
150
         Set_F_Float (Standard_Float);
151
 
152
         if Opt.Float_Format_Long = 'D' then
153
            Set_D_Float (Standard_Long_Float);
154
         else
155
            Set_G_Float (Standard_Long_Float);
156
         end if;
157
 
158
         --  Note: Long_Long_Float gets set only in the real VMS case,
159
         --  because this gives better results for testing out the use
160
         --  of VAX float on non-VMS environments with the -gnatdm switch.
161
 
162
         if OpenVMS_On_Target then
163
            Set_G_Float (Standard_Long_Long_Float);
164
         end if;
165
      end if;
166
   end Set_Standard_Fpt_Formats;
167
 
168
end Sem_VFpt;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.