PowerAda 50

From OC Systems Wiki!
< PowerAda:APPENDIX C. Implementation Characteristics‎ | Annex M
Revision as of 00:37, 25 April 2019 by imported>WikiVisor (Text replacement - "<" to "<")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

(50) The contents of the visible part of package System and its language-defined children.

See 13.7(2).

System

PACKAGE System IS
  PRAGMA Pure (System);
  TYPE Name IS (AIX_6000, Lynx_PPC, VxWorks_PPC);

  System_Name  : CONSTANT Name := AIX_6000;
  -- System-Dependent Named Numbers
  Min_Int: CONSTANT := Long_Integer'First;
  Max_Int: CONSTANT := Long_Integer'Last;
  Max_Binary_Modulus : CONSTANT := 2 ** Long_Integer'Size;
  Max_Nonbinary_Modulus : CONSTANT := Max_Int;
  Max_Base_Digits : CONSTANT := Long_Float'Digits;
  Max_Digits: CONSTANT := Long_Float'Digits;
  Max_Mantissa : CONSTANT := 31;
  Fine_Delta: CONSTANT := 1.0 / (2 ** Max_Mantissa);
  Tick: CONSTANT := 0.00006;
  -- Storage-related Declarations:
  TYPE Address IS PRIVATE;
  Null_Address : CONSTANT Address;
  Storage_Unit : CONSTANT := 8;
  Word_Size    : CONSTANT := 32;
  Memory_Size  : CONSTANT := 2**32;
  -- Address Comparison:
  FUNCTION "<"  (Left, Right : Address) RETURN Boolean;
  FUNCTION "<=" (Left, Right : Address) RETURN Boolean;
  FUNCTION ">"  (Left, Right : Address) RETURN Boolean;
  FUNCTION ">=" (Left, Right : Address) RETURN Boolean;
  FUNCTION "="  (Left, Right : Address) RETURN Boolean;
  PRAGMA Convention (Intrinsic, "<");
  PRAGMA Convention (Intrinsic, "<=");
  PRAGMA Convention (Intrinsic, ">");
  PRAGMA Convention (Intrinsic, ">=");
  PRAGMA Convention (Intrinsic, "=");
        PRAGMA Inline ("<");
        PRAGMA Inline ("<=");
        PRAGMA Inline (">");
        PRAGMA Inline (">=");
        PRAGMA Inline ( "=");
        -- Other System-Dependent Declarations
  TYPE Bit_Order IS (High_Order_First, Low_Order_First);
  Default_Bit_Order : CONSTANT Bit_Order;
  -- Priority-related Declarations (see D.1):
  SUBTYPE Any_Priority IS Integer RANGE 0..63;
  SUBTYPE Priority IS Any_Priority
        RANGE Any_Priority'First .. Any_Priority'Last - 1;
  SUBTYPE Interrupt_Priority IS Any_Priority
        RANGE Priority'Last + 1 .. Any_Priority'Last;
  Default_Priority : CONSTANT Priority := (Priority'First + 
        Priority'Last)/2;
-- The following two subprograms are obsolete Ada83 features 
-- provided for upward compatibility.
  FUNCTION Label (Name : String) RETURN Address;
        PRAGMA Interface (INTRINSIC, Label);
 --
 -- The LABEL meta-function allows a link name to be specified 
 -- as an address for an imported object in an address clause:
 --
 --  Object: Some_Type;
 --  for Object use at Label("OBJECT$$LINK_NAME");
 --
 -- System.Label returns Null_Address for non-literal 
 -- parameters.
        PROCEDURE Report_Error;
          --
          -- Report_Error should only be called within an exception 
          -- handler and produces an exception traceback like 
          -- tracebacks provided for unhandled exceptions.
PRIVATE
         ... implementation defined ...
END System;

System.Storage_Elements

PACKAGE System.Storage_Elements IS
        PRAGMA Pure(System.Storage_Elements);
        TYPE Storage_Offset IS RANGE -(2 ** 31) .. (2 ** 31) - 1;
        SUBTYPE Storage_Count IS Storage_Offset 
                RANGE 0..Storage_Offset'Last;
        TYPE Storage_Element IS MOD 2 ** Storage_Unit;
        FOR Storage_Element'Size USE Storage_Unit;
        TYPE Storage_Array IS ARRAY
        (Storage_Offset RANGE <> ) OF ALIASED Storage_Element;
        -- Address Arithmetic:
        FUNCTION "+"(Left : Address; Right : Storage_Offset)
          RETURN Address;
        FUNCTION "+"(Left : Storage_Offset; Right : Address)
          RETURN Address;
        FUNCTION "-"(Left : Address; Right : Storage_Offset)
          RETURN Address;
        FUNCTION "-"(Left, Right : Address)
          RETURN Storage_Offset;
        FUNCTION "mod"(Left : Address; Right : Storage_Offset)
          RETURN Storage_Offset;
        -- Conversion to/from integers:
        TYPE Integer_Address IS MOD Memory_Size;
        FUNCTION To_Address(Value : Integer_Address) 
                RETURN Address;
        FUNCTION To_Integer(Value : Address) 
                RETURN Integer_Address;
        PRAGMA Convention(Intrinsic, "+");
        PRAGMA Convention(Intrinsic, "-");
        PRAGMA Convention(Intrinsic, "mod");
        PRAGMA Convention(Intrinsic, "To_Address");
        PRAGMA Convention(Intrinsic, "To_Integer");
END System.Storage_Elements;

System.Address_To_Access_Conversions

GENERIC
        TYPE Object IS LIMITED PRIVATE;
PACKAGE System.Address_To_Access_Conversions IS
        PRAGMA Preelaborate (Address_To_Access_Conversions);
        TYPE Object_Pointer IS ACCESS ALL Object;
        FUNCTION To_Pointer (Value : Address) 
                RETURN Object_Pointer;
        FUNCTION To_Address (Value : Object_Pointer) 
                RETURN Address;
        PRAGMA Convention (Intrinsic, To_Pointer);
        PRAGMA Convention (Intrinsic, To_Address);
END System.Address_To_Access_Conversions;

System.Storage_Pools

WITH Ada.Finalization;
WITH System.Storage_Elements;
PACKAGE System.Storage_Pools IS
   PRAGMA Preelaborate(Storage_Pools);
   TYPE Root_Storage_Pool IS ABSTRACT NEW
      Ada.Finalization.Limited_Controlled WITH PRIVATE;
   PROCEDURE Allocate(
      Pool : IN OUT Root_Storage_Pool;
      Storage_Address : OUT Address;
      Size_In_Storage_Elements : IN
        Storage_Elements.Storage_Count;
      Alignment : IN Storage_Elements.Storage_Count) IS
    ABSTRACT;
   PROCEDURE Deallocate(
      Pool : IN OUT Root_Storage_Pool;
      Storage_Address : IN Address;
      Size_In_Storage_Elements : IN
        Storage_Elements.Storage_Count;
      Alignment : IN Storage_Elements.Storage_Count) IS
   ABSTRACT;
   FUNCTION Storage_Size(Pool : Root_Storage_Pool)
      RETURN Storage_Elements.Storage_Count IS ABSTRACT;
PRIVATE
   TYPE Root_Storage_Pool IS NEW
      Ada.Finalization.Limited_Controlled WITH NULL RECORD;
END System.Storage_Pools;.