1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
10 -- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 -- Program to print out listing of Standard package for the target (not
29 -- the host) with all constants appearing explicitly. This is not really
30 -- valid Ada, since one cannot really define new base types, but it is a
31 -- helpful listing from a documentation point of view.
33 -- Note that special care has been taken to use the host parameters for
34 -- integer and floating point sizes.
36 with Ada
.Text_IO
; use Ada
.Text_IO
;
37 with Ttypef
; use Ttypef
;
38 with Ttypes
; use Ttypes
;
39 with Types
; use Types
;
43 procedure P
(Item
: String) renames Ada
.Text_IO
.Put_Line
;
45 procedure P_Int_Range
(Size
: Pos
; Put_First
: Boolean := True);
46 -- Prints the range of an integer based on its Size. If Put_First is
47 -- False, then skip the first bound.
49 procedure P_Float_Range
(Nb_Digits
: Pos
);
50 -- Prints the maximum range of a Float whose 'Digits is given by Nb_Digits
56 procedure P_Float_Range
(Nb_Digits
: Pos
) is
58 -- This routine assumes only IEEE floats.
59 -- ??? Should the following be adapted for OpenVMS ?
63 P
(" range " & IEEES_First
'Universal_Literal_String & " .. " &
64 IEEES_Last
'Universal_Literal_String & ";");
66 P
(" range " & IEEEL_First
'Universal_Literal_String & " .. " &
67 IEEEL_Last
'Universal_Literal_String & ";");
69 P
(" range " & IEEEX_First
'Universal_Literal_String & " .. " &
70 IEEEX_Last
'Universal_Literal_String & ";");
76 -- If one of the floating point types of the host computer has the
77 -- same digits as the target float we are processing, then print out
78 -- the float range using the host computer float type.
80 if Nb_Digits
= Short_Float'Digits then
82 Short_Float'First'Img & " .. " & Short_Float'Last'Img
);
84 elsif Nb_Digits
= Float'Digits then
86 Float'First'Img & " .. " & Float'Last'Img
);
88 elsif Nb_Digits
= Long_Float'Digits then
90 Long_Float'First'Img & " .. " & Long_Float'Last'Img
);
92 elsif Nb_Digits
= Long_Long_Float'Digits then
94 Long_Long_Float'First'Img & " .. " & Long_Long_Float'Last'Img
);
104 procedure P_Int_Range
(Size
: Pos
; Put_First
: Boolean := True) is
107 Put
(" is range -(2 **" & Pos
'Image (Size
- 1) & ")");
109 P
(" .. +(2 **" & Pos
'Image (Size
- 1) & " - 1);");
112 -- Start of processing for GnatPsta
115 P
("package Standard is");
116 P
("pragma Pure(Standard);");
119 P
(" type Boolean is (False, True);");
124 Put
(" type Integer");
125 P_Int_Range
(Standard_Integer_Size
);
128 Put
(" subtype Natural is Integer range 0");
129 P_Int_Range
(Standard_Integer_Size
, Put_First
=> False);
131 Put
(" subtype Positive is Integer range 1");
132 P_Int_Range
(Standard_Integer_Size
, Put_First
=> False);
135 Put
(" type Short_Short_Integer");
136 P_Int_Range
(Standard_Short_Short_Integer_Size
);
138 Put
(" type Short_Integer ");
139 P_Int_Range
(Standard_Short_Integer_Size
);
141 Put
(" type Long_Integer ");
142 P_Int_Range
(Standard_Long_Integer_Size
);
144 Put
(" type Long_Long_Integer ");
145 P_Int_Range
(Standard_Long_Long_Integer_Size
);
148 -- Floating point types
150 P
(" type Short_Float is digits"
151 & Standard_Short_Float_Digits
'Img);
152 P_Float_Range
(Standard_Short_Float_Digits
);
154 P
(" type Float is digits"
155 & Standard_Float_Digits
'Img);
156 P_Float_Range
(Standard_Float_Digits
);
158 P
(" type Long_Float is digits"
159 & Standard_Long_Float_Digits
'Img);
160 P_Float_Range
(Standard_Long_Float_Digits
);
162 P
(" type Long_Long_Float is digits"
163 & Standard_Long_Long_Float_Digits
'Img);
164 P_Float_Range
(Standard_Long_Long_Float_Digits
);
166 P
(" -- function ""*"" (Left : root_integer; Right : root_real)");
167 P
(" -- return root_real;");
170 P
(" -- function ""*"" (Left : root_real; Right : root_integer)");
171 P
(" -- return root_real;");
174 P
(" -- function ""/"" (Left : root_real; Right : root_integer)");
175 P
(" -- return root_real;");
178 P
(" -- function ""*"" (Left : universal_fixed; " &
179 "Right : universal_fixed)");
180 P
(" -- return universal_fixed;");
183 P
(" -- function ""/"" (Left : universal_fixed; " &
184 "Right : universal_fixed)");
185 P
(" -- return universal_fixed;");
188 P
(" -- The declaration of type Character is based on the standard");
189 P
(" -- ISO 8859-1 character set.");
192 P
(" -- There are no character literals corresponding to the positions");
193 P
(" -- for control characters. They are indicated by lower case");
194 P
(" -- identifiers in the following list.");
197 P
(" -- Note: this type cannot be represented accurately in Ada");
200 P
(" -- type Character is");
203 P
(" -- (nul, soh, stx, etx, eot, enq, ack, bel,");
204 P
(" -- bs, ht, lf, vt, ff, cr, so, si,");
207 P
(" -- dle, dc1, dc2, dc3, dc4, nak, syn, etb,");
208 P
(" -- can, em, sub, esc, fs, gs, rs, us,");
211 P
(" -- ' ', '!', '""', '#', '$', '%', '&', ''',");
212 P
(" -- '(', ')', '*', '+', ',', '-', '.', '/',");
215 P
(" -- '0', '1', '2', '3', '4', '5', '6', '7',");
216 P
(" -- '8', '9', ':', ';', '<', '=', '>', '?',");
219 P
(" -- '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',");
220 P
(" -- 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',");
223 P
(" -- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',");
224 P
(" -- 'X', 'Y', 'Z', '[', '\', ']', '^', '_',");
227 P
(" -- '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',");
228 P
(" -- 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',");
231 P
(" -- 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',");
232 P
(" -- 'x', 'y', 'z', '{', '|', '}', '~', del,");
235 P
(" -- reserved_128, reserved_129, bph, nbh,");
236 P
(" -- reserved_132, nel, ssa, esa,");
239 P
(" -- hts, htj, vts, pld, plu, ri, ss2, ss3,");
242 P
(" -- dcs, pu1, pu2, sts, cch, mw, spa, epa,");
245 P
(" -- sos, reserved_153, sci, csi,");
246 P
(" -- st, osc, pm, apc,");
252 P
(" -- The declaration of type Wide_Character is based " &
254 P
(" -- ISO 10646 BMP character set.");
257 P
(" -- Note: this type cannot be represented accurately in Ada");
260 P
(" -- The first 256 positions have the same contents as " &
264 P
(" -- type Wide_Character is (nul, soh ... FFFE, FFFF);");
267 P
(" package ASCII is");
270 P
(" -- Control characters:");
273 P
(" NUL : constant Character := Character'Val (16#00#);");
274 P
(" SOH : constant Character := Character'Val (16#01#);");
275 P
(" STX : constant Character := Character'Val (16#02#);");
276 P
(" ETX : constant Character := Character'Val (16#03#);");
277 P
(" EOT : constant Character := Character'Val (16#04#);");
278 P
(" ENQ : constant Character := Character'Val (16#05#);");
279 P
(" ACK : constant Character := Character'Val (16#06#);");
280 P
(" BEL : constant Character := Character'Val (16#07#);");
281 P
(" BS : constant Character := Character'Val (16#08#);");
282 P
(" HT : constant Character := Character'Val (16#09#);");
283 P
(" LF : constant Character := Character'Val (16#0A#);");
284 P
(" VT : constant Character := Character'Val (16#0B#);");
285 P
(" FF : constant Character := Character'Val (16#0C#);");
286 P
(" CR : constant Character := Character'Val (16#0D#);");
287 P
(" SO : constant Character := Character'Val (16#0E#);");
288 P
(" SI : constant Character := Character'Val (16#0F#);");
289 P
(" DLE : constant Character := Character'Val (16#10#);");
290 P
(" DC1 : constant Character := Character'Val (16#11#);");
291 P
(" DC2 : constant Character := Character'Val (16#12#);");
292 P
(" DC3 : constant Character := Character'Val (16#13#);");
293 P
(" DC4 : constant Character := Character'Val (16#14#);");
294 P
(" NAK : constant Character := Character'Val (16#15#);");
295 P
(" SYN : constant Character := Character'Val (16#16#);");
296 P
(" ETB : constant Character := Character'Val (16#17#);");
297 P
(" CAN : constant Character := Character'Val (16#18#);");
298 P
(" EM : constant Character := Character'Val (16#19#);");
299 P
(" SUB : constant Character := Character'Val (16#1A#);");
300 P
(" ESC : constant Character := Character'Val (16#1B#);");
301 P
(" FS : constant Character := Character'Val (16#1C#);");
302 P
(" GS : constant Character := Character'Val (16#1D#);");
303 P
(" RS : constant Character := Character'Val (16#1E#);");
304 P
(" US : constant Character := Character'Val (16#1F#);");
305 P
(" DEL : constant Character := Character'Val (16#7F#);");
308 P
(" -- Other characters:");
311 P
(" Exclam : constant Character := '!';");
312 P
(" Quotation : constant Character := '""';");
313 P
(" Sharp : constant Character := '#';");
314 P
(" Dollar : constant Character := '$';");
315 P
(" Percent : constant Character := '%';");
316 P
(" Ampersand : constant Character := '&';");
317 P
(" Colon : constant Character := ':';");
318 P
(" Semicolon : constant Character := ';';");
319 P
(" Query : constant Character := '?';");
320 P
(" At_Sign : constant Character := '@';");
321 P
(" L_Bracket : constant Character := '[';");
322 P
(" Back_Slash : constant Character := '\';");
323 P
(" R_Bracket : constant Character := ']';");
324 P
(" Circumflex : constant Character := '^';");
325 P
(" Underline : constant Character := '_';");
326 P
(" Grave : constant Character := '`';");
327 P
(" L_Brace : constant Character := '{';");
328 P
(" Bar : constant Character := '|';");
329 P
(" R_Brace : constant Character := '}';");
330 P
(" Tilde : constant Character := '~';");
333 P
(" -- Lower case letters:");
336 for C
in Character range 'a' .. 'z' loop
337 P
(" LC_" & Character'Val (Character'Pos (C
) - 32) &
338 " : constant Character := '" & C
& "';");
345 P
(" type String is array (Positive range <>) of Character;");
346 P
(" pragma Pack (String);");
349 P
(" type Wide_String is array (Positive range <>) of Wide_Character;");
350 P
(" pragma Pack (Wide_String);");
353 -- Here it's OK to use the Duration type of the host compiler since
354 -- the implementation of Duration in GNAT is target independent.
356 P
(" type Duration is delta" &
357 Duration'Image (Duration'Delta));
358 P
(" range -((2 **" & Natural'Image (Duration'Size - 1) &
359 " - 1) *" & Duration'Image (Duration'Delta) & ") ..");
360 P
(" +((2 **" & Natural'Image (Duration'Size - 1) &
361 " - 1) *" & Duration'Image (Duration'Delta) & ");");
362 P
(" for Duration'Small use" & Duration'Image (Duration'Small) & ";");
365 P
(" Constraint_Error : exception;");
366 P
(" Program_Error : exception;");
367 P
(" Storage_Error : exception;");
368 P
(" Tasking_Error : exception;");