gcc/ada/gnatpsys.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                          GNAT SYSTEM UTILITIES                           --
   4 --                                                                          --
   5 --                            G N A T P S Y S                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.3 $                               --
  10 --                                                                          --
  11 --             Copyright (C) 1997 Free Software Foundation, Inc.            --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 --  Program to print out listing of System package with all constants
  30 --  appearing explicitly.
  31
  32 with Ada.Text_IO;
  33 with System; use System;
  34 with Gnatvsn;
  35
  36 procedure GnatPsys is
  37    pragma Ident (Gnatvsn.Gnat_Version_String);
  38
  39    procedure P (Item : String) renames Ada.Text_IO.Put_Line;
  40
  41 begin
  42    P ("package System is");
  43
  44    P ("pragma Pure (System);");
  45
  46    P ("");
  47
  48    P ("   type Name is (SYSTEM_NAME_GNAT);");
  49
  50    P ("   System_Name : constant Name := SYSTEM_NAME_GNAT;");
  51
  52    P ("");
  53
  54    P ("   --  System-Dependent Named Numbers");
  55
  56    P ("");
  57
  58    P ("   Min_Int                : constant := -(2 **" &
  59         Long_Long_Integer'Image (Long_Long_Integer'Size - 1) & ");");
  60
  61    P ("   Max_Int                : constant := 2 **" &
  62         Long_Long_Integer'Image (Long_Long_Integer'Size - 1) & " - 1;");
  63
  64    P ("");
  65
  66    P ("   Max_Binary_Modulus     : constant := 2 **" &
  67         Long_Long_Integer'Image (Long_Long_Integer'Size) & ";");
  68
  69    P ("   Max_Nonbinary_Modulus  : constant :=" &
  70         Integer'Image (Integer'Last) & ";");
  71
  72    P ("");
  73
  74    P ("   Max_Base_Digits        : constant :=" &
  75         Natural'Image (Long_Long_Float'Digits) & ";");
  76
  77    P ("   Max_Digits             : constant :=" &
  78         Natural'Image (Long_Long_Float'Digits) & ";");
  79
  80    P ("");
  81
  82    P ("   Max_Mantissa           : constant := 63;");
  83
  84    P ("   Fine_Delta             : constant := 2.0 ** (-Max_Mantissa);");
  85
  86    P ("");
  87
  88    P ("   Tick                   : constant :=" &
  89           Duration'Image (Duration (Standard'Tick)) & ";");
  90
  91    P ("");
  92
  93    P ("   --  Storage-related Declarations");
  94
  95    P ("");
  96
  97    P ("   type Address is private;");
  98
  99    P ("   Null_Address : constant Address;");
 100
 101    P ("");
 102
 103    P ("   Storage_Unit           : constant :=" &
 104         Natural'Image (Standard'Storage_Unit) & ";");
 105
 106    P ("   Word_Size              : constant :=" &
 107         Natural'Image (Standard'Word_Size) & ";");
 108
 109    P ("   Memory_Size            : constant := 2 **" &
 110         Natural'Image (Standard'Address_Size) & ";");
 111
 112    P ("");
 113    P ("   --  Address comparison");
 114    P ("");
 115    P ("   function ""<""  (Left, Right : Address) return Boolean;");
 116    P ("   function ""<="" (Left, Right : Address) return Boolean;");
 117    P ("   function "">""  (Left, Right : Address) return Boolean;");
 118    P ("   function "">="" (Left, Right : Address) return Boolean;");
 119    P ("   function ""=""  (Left, Right : Address) return Boolean;");
 120    P ("");
 121    P ("   pragma Import (Intrinsic, ""<""); ");
 122    P ("   pragma Import (Intrinsic, ""<="");");
 123    P ("   pragma Import (Intrinsic, "">""); ");
 124    P ("   pragma Import (Intrinsic, "">="");");
 125    P ("   pragma Import (Intrinsic, ""=""); ");
 126    P ("");
 127    P ("   --  Other System-Dependent Declarations");
 128    P ("");
 129    P ("   type Bit_Order is (High_Order_First, Low_Order_First);");
 130    P ("   Default_Bit_Order : constant Bit_Order;");
 131    P ("");
 132    P ("   --  Priority-related Declarations (RM D.1)");
 133    P ("");
 134    P ("   subtype Any_Priority is Integer range 0 .." &
 135         Natural'Image (Standard'Max_Interrupt_Priority) & ";");
 136
 137    P ("");
 138
 139    P ("   subtype Priority is Any_Priority range 0 .." &
 140         Natural'Image (Standard'Max_Priority) & ";");
 141
 142    P ("");
 143
 144    P ("   subtype Interrupt_Priority is Any_Priority range" &
 145         Natural'Image (Standard'Max_Priority + 1) & " .." &
 146         Natural'Image (Standard'Max_Interrupt_Priority) & ";");
 147
 148    P ("");
 149
 150    P ("   Default_Priority : constant Priority :=" &
 151         Natural'Image ((Priority'First + Priority'Last) / 2) & ";");
 152
 153    P ("");
 154
 155    P ("private");
 156
 157    P ("");
 158
 159    P ("   type Address is mod Memory_Size;                                  ");
 160
 161    P ("   Null_Address : constant Address := 0;                             ");
 162
 163    P ("                                                                     ");
 164
 165    P ("   Default_Bit_Order : constant Bit_Order := " &
 166          Bit_Order'Image (Bit_Order'Val (Standard'Default_Bit_Order)) & ";");
 167
 168    P ("");
 169
 170    P ("end System;");
 171 end GnatPsys;