===================================================================
@@ -34,7 +34,6 @@
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
-with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
@@ -77,365 +76,6 @@
-- right rotate into a left rotate, avoiding the subtract, if the machine
-- architecture provides such an instruction.
- ----------------------------------------------
- -- Entity Tables for Packed Access Routines --
- ----------------------------------------------
-
- -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
- -- routines. This table provides the entity for the proper routine.
-
- type E_Array is array (Int range 01 .. 63) of RE_Id;
-
- -- Array of Bits_nn entities. Note that we do not use library routines
- -- for the 8-bit and 16-bit cases, but we still fill in the table, using
- -- entries from System.Unsigned, because we also use this table for
- -- certain special unchecked conversions in the big-endian case.
-
- Bits_Id : constant E_Array :=
- (01 => RE_Bits_1,
- 02 => RE_Bits_2,
- 03 => RE_Bits_03,
- 04 => RE_Bits_4,
- 05 => RE_Bits_05,
- 06 => RE_Bits_06,
- 07 => RE_Bits_07,
- 08 => RE_Unsigned_8,
- 09 => RE_Bits_09,
- 10 => RE_Bits_10,
- 11 => RE_Bits_11,
- 12 => RE_Bits_12,
- 13 => RE_Bits_13,
- 14 => RE_Bits_14,
- 15 => RE_Bits_15,
- 16 => RE_Unsigned_16,
- 17 => RE_Bits_17,
- 18 => RE_Bits_18,
- 19 => RE_Bits_19,
- 20 => RE_Bits_20,
- 21 => RE_Bits_21,
- 22 => RE_Bits_22,
- 23 => RE_Bits_23,
- 24 => RE_Bits_24,
- 25 => RE_Bits_25,
- 26 => RE_Bits_26,
- 27 => RE_Bits_27,
- 28 => RE_Bits_28,
- 29 => RE_Bits_29,
- 30 => RE_Bits_30,
- 31 => RE_Bits_31,
- 32 => RE_Unsigned_32,
- 33 => RE_Bits_33,
- 34 => RE_Bits_34,
- 35 => RE_Bits_35,
- 36 => RE_Bits_36,
- 37 => RE_Bits_37,
- 38 => RE_Bits_38,
- 39 => RE_Bits_39,
- 40 => RE_Bits_40,
- 41 => RE_Bits_41,
- 42 => RE_Bits_42,
- 43 => RE_Bits_43,
- 44 => RE_Bits_44,
- 45 => RE_Bits_45,
- 46 => RE_Bits_46,
- 47 => RE_Bits_47,
- 48 => RE_Bits_48,
- 49 => RE_Bits_49,
- 50 => RE_Bits_50,
- 51 => RE_Bits_51,
- 52 => RE_Bits_52,
- 53 => RE_Bits_53,
- 54 => RE_Bits_54,
- 55 => RE_Bits_55,
- 56 => RE_Bits_56,
- 57 => RE_Bits_57,
- 58 => RE_Bits_58,
- 59 => RE_Bits_59,
- 60 => RE_Bits_60,
- 61 => RE_Bits_61,
- 62 => RE_Bits_62,
- 63 => RE_Bits_63);
-
- -- Array of Get routine entities. These are used to obtain an element from
- -- a packed array. The N'th entry is used to obtain elements from a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Get_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_Get_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_Get_10,
- 11 => RE_Get_11,
- 12 => RE_Get_12,
- 13 => RE_Get_13,
- 14 => RE_Get_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_Get_18,
- 19 => RE_Get_19,
- 20 => RE_Get_20,
- 21 => RE_Get_21,
- 22 => RE_Get_22,
- 23 => RE_Get_23,
- 24 => RE_Get_24,
- 25 => RE_Get_25,
- 26 => RE_Get_26,
- 27 => RE_Get_27,
- 28 => RE_Get_28,
- 29 => RE_Get_29,
- 30 => RE_Get_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_Get_34,
- 35 => RE_Get_35,
- 36 => RE_Get_36,
- 37 => RE_Get_37,
- 38 => RE_Get_38,
- 39 => RE_Get_39,
- 40 => RE_Get_40,
- 41 => RE_Get_41,
- 42 => RE_Get_42,
- 43 => RE_Get_43,
- 44 => RE_Get_44,
- 45 => RE_Get_45,
- 46 => RE_Get_46,
- 47 => RE_Get_47,
- 48 => RE_Get_48,
- 49 => RE_Get_49,
- 50 => RE_Get_50,
- 51 => RE_Get_51,
- 52 => RE_Get_52,
- 53 => RE_Get_53,
- 54 => RE_Get_54,
- 55 => RE_Get_55,
- 56 => RE_Get_56,
- 57 => RE_Get_57,
- 58 => RE_Get_58,
- 59 => RE_Get_59,
- 60 => RE_Get_60,
- 61 => RE_Get_61,
- 62 => RE_Get_62,
- 63 => RE_Get_63);
-
- -- Array of Get routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- GetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_GetU_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_GetU_10,
- 11 => RE_Get_11,
- 12 => RE_GetU_12,
- 13 => RE_Get_13,
- 14 => RE_GetU_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_GetU_18,
- 19 => RE_Get_19,
- 20 => RE_GetU_20,
- 21 => RE_Get_21,
- 22 => RE_GetU_22,
- 23 => RE_Get_23,
- 24 => RE_GetU_24,
- 25 => RE_Get_25,
- 26 => RE_GetU_26,
- 27 => RE_Get_27,
- 28 => RE_GetU_28,
- 29 => RE_Get_29,
- 30 => RE_GetU_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_GetU_34,
- 35 => RE_Get_35,
- 36 => RE_GetU_36,
- 37 => RE_Get_37,
- 38 => RE_GetU_38,
- 39 => RE_Get_39,
- 40 => RE_GetU_40,
- 41 => RE_Get_41,
- 42 => RE_GetU_42,
- 43 => RE_Get_43,
- 44 => RE_GetU_44,
- 45 => RE_Get_45,
- 46 => RE_GetU_46,
- 47 => RE_Get_47,
- 48 => RE_GetU_48,
- 49 => RE_Get_49,
- 50 => RE_GetU_50,
- 51 => RE_Get_51,
- 52 => RE_GetU_52,
- 53 => RE_Get_53,
- 54 => RE_GetU_54,
- 55 => RE_Get_55,
- 56 => RE_GetU_56,
- 57 => RE_Get_57,
- 58 => RE_GetU_58,
- 59 => RE_Get_59,
- 60 => RE_GetU_60,
- 61 => RE_Get_61,
- 62 => RE_GetU_62,
- 63 => RE_Get_63);
-
- -- Array of Set routine entities. These are used to assign an element of a
- -- packed array. The N'th entry is used to assign elements for a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Set_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_Set_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_Set_10,
- 11 => RE_Set_11,
- 12 => RE_Set_12,
- 13 => RE_Set_13,
- 14 => RE_Set_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_Set_18,
- 19 => RE_Set_19,
- 20 => RE_Set_20,
- 21 => RE_Set_21,
- 22 => RE_Set_22,
- 23 => RE_Set_23,
- 24 => RE_Set_24,
- 25 => RE_Set_25,
- 26 => RE_Set_26,
- 27 => RE_Set_27,
- 28 => RE_Set_28,
- 29 => RE_Set_29,
- 30 => RE_Set_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_Set_34,
- 35 => RE_Set_35,
- 36 => RE_Set_36,
- 37 => RE_Set_37,
- 38 => RE_Set_38,
- 39 => RE_Set_39,
- 40 => RE_Set_40,
- 41 => RE_Set_41,
- 42 => RE_Set_42,
- 43 => RE_Set_43,
- 44 => RE_Set_44,
- 45 => RE_Set_45,
- 46 => RE_Set_46,
- 47 => RE_Set_47,
- 48 => RE_Set_48,
- 49 => RE_Set_49,
- 50 => RE_Set_50,
- 51 => RE_Set_51,
- 52 => RE_Set_52,
- 53 => RE_Set_53,
- 54 => RE_Set_54,
- 55 => RE_Set_55,
- 56 => RE_Set_56,
- 57 => RE_Set_57,
- 58 => RE_Set_58,
- 59 => RE_Set_59,
- 60 => RE_Set_60,
- 61 => RE_Set_61,
- 62 => RE_Set_62,
- 63 => RE_Set_63);
-
- -- Array of Set routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- SetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_SetU_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_SetU_10,
- 11 => RE_Set_11,
- 12 => RE_SetU_12,
- 13 => RE_Set_13,
- 14 => RE_SetU_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_SetU_18,
- 19 => RE_Set_19,
- 20 => RE_SetU_20,
- 21 => RE_Set_21,
- 22 => RE_SetU_22,
- 23 => RE_Set_23,
- 24 => RE_SetU_24,
- 25 => RE_Set_25,
- 26 => RE_SetU_26,
- 27 => RE_Set_27,
- 28 => RE_SetU_28,
- 29 => RE_Set_29,
- 30 => RE_SetU_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_SetU_34,
- 35 => RE_Set_35,
- 36 => RE_SetU_36,
- 37 => RE_Set_37,
- 38 => RE_SetU_38,
- 39 => RE_Set_39,
- 40 => RE_SetU_40,
- 41 => RE_Set_41,
- 42 => RE_SetU_42,
- 43 => RE_Set_43,
- 44 => RE_SetU_44,
- 45 => RE_Set_45,
- 46 => RE_SetU_46,
- 47 => RE_Set_47,
- 48 => RE_SetU_48,
- 49 => RE_Set_49,
- 50 => RE_SetU_50,
- 51 => RE_Set_51,
- 52 => RE_SetU_52,
- 53 => RE_Set_53,
- 54 => RE_SetU_54,
- 55 => RE_Set_55,
- 56 => RE_SetU_56,
- 57 => RE_Set_57,
- 58 => RE_SetU_58,
- 59 => RE_Set_59,
- 60 => RE_SetU_60,
- 61 => RE_Set_61,
- 62 => RE_SetU_62,
- 63 => RE_Set_63);
-
-----------------------
-- Local Subprograms --
-----------------------
===================================================================
@@ -25,7 +25,8 @@
-- Expand routines for manipulation of packed arrays
-with Types; use Types;
+with Rtsfind; use Rtsfind;
+with Types; use Types;
package Exp_Pakd is
@@ -203,6 +204,367 @@
-- and now, we do indeed have the same representation for the memory
-- version in the constrained and unconstrained cases.
+ ----------------------------------------------
+ -- Entity Tables for Packed Access Routines --
+ ----------------------------------------------
+
+ -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
+ -- routines. These tables provide the entity for the proper routine. They
+ -- are exposed in the spec to allow checking for the presence of the needed
+ -- routine when an array is subject to pragma Pack.
+
+ type E_Array is array (Int range 01 .. 63) of RE_Id;
+
+ -- Array of Bits_nn entities. Note that we do not use library routines
+ -- for the 8-bit and 16-bit cases, but we still fill in the table, using
+ -- entries from System.Unsigned, because we also use this table for
+ -- certain special unchecked conversions in the big-endian case.
+
+ Bits_Id : constant E_Array :=
+ (01 => RE_Bits_1,
+ 02 => RE_Bits_2,
+ 03 => RE_Bits_03,
+ 04 => RE_Bits_4,
+ 05 => RE_Bits_05,
+ 06 => RE_Bits_06,
+ 07 => RE_Bits_07,
+ 08 => RE_Unsigned_8,
+ 09 => RE_Bits_09,
+ 10 => RE_Bits_10,
+ 11 => RE_Bits_11,
+ 12 => RE_Bits_12,
+ 13 => RE_Bits_13,
+ 14 => RE_Bits_14,
+ 15 => RE_Bits_15,
+ 16 => RE_Unsigned_16,
+ 17 => RE_Bits_17,
+ 18 => RE_Bits_18,
+ 19 => RE_Bits_19,
+ 20 => RE_Bits_20,
+ 21 => RE_Bits_21,
+ 22 => RE_Bits_22,
+ 23 => RE_Bits_23,
+ 24 => RE_Bits_24,
+ 25 => RE_Bits_25,
+ 26 => RE_Bits_26,
+ 27 => RE_Bits_27,
+ 28 => RE_Bits_28,
+ 29 => RE_Bits_29,
+ 30 => RE_Bits_30,
+ 31 => RE_Bits_31,
+ 32 => RE_Unsigned_32,
+ 33 => RE_Bits_33,
+ 34 => RE_Bits_34,
+ 35 => RE_Bits_35,
+ 36 => RE_Bits_36,
+ 37 => RE_Bits_37,
+ 38 => RE_Bits_38,
+ 39 => RE_Bits_39,
+ 40 => RE_Bits_40,
+ 41 => RE_Bits_41,
+ 42 => RE_Bits_42,
+ 43 => RE_Bits_43,
+ 44 => RE_Bits_44,
+ 45 => RE_Bits_45,
+ 46 => RE_Bits_46,
+ 47 => RE_Bits_47,
+ 48 => RE_Bits_48,
+ 49 => RE_Bits_49,
+ 50 => RE_Bits_50,
+ 51 => RE_Bits_51,
+ 52 => RE_Bits_52,
+ 53 => RE_Bits_53,
+ 54 => RE_Bits_54,
+ 55 => RE_Bits_55,
+ 56 => RE_Bits_56,
+ 57 => RE_Bits_57,
+ 58 => RE_Bits_58,
+ 59 => RE_Bits_59,
+ 60 => RE_Bits_60,
+ 61 => RE_Bits_61,
+ 62 => RE_Bits_62,
+ 63 => RE_Bits_63);
+
+ -- Array of Get routine entities. These are used to obtain an element from
+ -- a packed array. The N'th entry is used to obtain elements from a packed
+ -- array whose component size is N. RE_Null is used as a null entry, for
+ -- the cases where a library routine is not used.
+
+ Get_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Get_03,
+ 04 => RE_Null,
+ 05 => RE_Get_05,
+ 06 => RE_Get_06,
+ 07 => RE_Get_07,
+ 08 => RE_Null,
+ 09 => RE_Get_09,
+ 10 => RE_Get_10,
+ 11 => RE_Get_11,
+ 12 => RE_Get_12,
+ 13 => RE_Get_13,
+ 14 => RE_Get_14,
+ 15 => RE_Get_15,
+ 16 => RE_Null,
+ 17 => RE_Get_17,
+ 18 => RE_Get_18,
+ 19 => RE_Get_19,
+ 20 => RE_Get_20,
+ 21 => RE_Get_21,
+ 22 => RE_Get_22,
+ 23 => RE_Get_23,
+ 24 => RE_Get_24,
+ 25 => RE_Get_25,
+ 26 => RE_Get_26,
+ 27 => RE_Get_27,
+ 28 => RE_Get_28,
+ 29 => RE_Get_29,
+ 30 => RE_Get_30,
+ 31 => RE_Get_31,
+ 32 => RE_Null,
+ 33 => RE_Get_33,
+ 34 => RE_Get_34,
+ 35 => RE_Get_35,
+ 36 => RE_Get_36,
+ 37 => RE_Get_37,
+ 38 => RE_Get_38,
+ 39 => RE_Get_39,
+ 40 => RE_Get_40,
+ 41 => RE_Get_41,
+ 42 => RE_Get_42,
+ 43 => RE_Get_43,
+ 44 => RE_Get_44,
+ 45 => RE_Get_45,
+ 46 => RE_Get_46,
+ 47 => RE_Get_47,
+ 48 => RE_Get_48,
+ 49 => RE_Get_49,
+ 50 => RE_Get_50,
+ 51 => RE_Get_51,
+ 52 => RE_Get_52,
+ 53 => RE_Get_53,
+ 54 => RE_Get_54,
+ 55 => RE_Get_55,
+ 56 => RE_Get_56,
+ 57 => RE_Get_57,
+ 58 => RE_Get_58,
+ 59 => RE_Get_59,
+ 60 => RE_Get_60,
+ 61 => RE_Get_61,
+ 62 => RE_Get_62,
+ 63 => RE_Get_63);
+
+ -- Array of Get routine entities to be used in the case where the packed
+ -- array is itself a component of a packed structure, and therefore may not
+ -- be fully aligned. This only affects the even sizes, since for the odd
+ -- sizes, we do not get any fixed alignment in any case.
+
+ GetU_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Get_03,
+ 04 => RE_Null,
+ 05 => RE_Get_05,
+ 06 => RE_GetU_06,
+ 07 => RE_Get_07,
+ 08 => RE_Null,
+ 09 => RE_Get_09,
+ 10 => RE_GetU_10,
+ 11 => RE_Get_11,
+ 12 => RE_GetU_12,
+ 13 => RE_Get_13,
+ 14 => RE_GetU_14,
+ 15 => RE_Get_15,
+ 16 => RE_Null,
+ 17 => RE_Get_17,
+ 18 => RE_GetU_18,
+ 19 => RE_Get_19,
+ 20 => RE_GetU_20,
+ 21 => RE_Get_21,
+ 22 => RE_GetU_22,
+ 23 => RE_Get_23,
+ 24 => RE_GetU_24,
+ 25 => RE_Get_25,
+ 26 => RE_GetU_26,
+ 27 => RE_Get_27,
+ 28 => RE_GetU_28,
+ 29 => RE_Get_29,
+ 30 => RE_GetU_30,
+ 31 => RE_Get_31,
+ 32 => RE_Null,
+ 33 => RE_Get_33,
+ 34 => RE_GetU_34,
+ 35 => RE_Get_35,
+ 36 => RE_GetU_36,
+ 37 => RE_Get_37,
+ 38 => RE_GetU_38,
+ 39 => RE_Get_39,
+ 40 => RE_GetU_40,
+ 41 => RE_Get_41,
+ 42 => RE_GetU_42,
+ 43 => RE_Get_43,
+ 44 => RE_GetU_44,
+ 45 => RE_Get_45,
+ 46 => RE_GetU_46,
+ 47 => RE_Get_47,
+ 48 => RE_GetU_48,
+ 49 => RE_Get_49,
+ 50 => RE_GetU_50,
+ 51 => RE_Get_51,
+ 52 => RE_GetU_52,
+ 53 => RE_Get_53,
+ 54 => RE_GetU_54,
+ 55 => RE_Get_55,
+ 56 => RE_GetU_56,
+ 57 => RE_Get_57,
+ 58 => RE_GetU_58,
+ 59 => RE_Get_59,
+ 60 => RE_GetU_60,
+ 61 => RE_Get_61,
+ 62 => RE_GetU_62,
+ 63 => RE_Get_63);
+
+ -- Array of Set routine entities. These are used to assign an element of a
+ -- packed array. The N'th entry is used to assign elements for a packed
+ -- array whose component size is N. RE_Null is used as a null entry, for
+ -- the cases where a library routine is not used.
+
+ Set_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Set_03,
+ 04 => RE_Null,
+ 05 => RE_Set_05,
+ 06 => RE_Set_06,
+ 07 => RE_Set_07,
+ 08 => RE_Null,
+ 09 => RE_Set_09,
+ 10 => RE_Set_10,
+ 11 => RE_Set_11,
+ 12 => RE_Set_12,
+ 13 => RE_Set_13,
+ 14 => RE_Set_14,
+ 15 => RE_Set_15,
+ 16 => RE_Null,
+ 17 => RE_Set_17,
+ 18 => RE_Set_18,
+ 19 => RE_Set_19,
+ 20 => RE_Set_20,
+ 21 => RE_Set_21,
+ 22 => RE_Set_22,
+ 23 => RE_Set_23,
+ 24 => RE_Set_24,
+ 25 => RE_Set_25,
+ 26 => RE_Set_26,
+ 27 => RE_Set_27,
+ 28 => RE_Set_28,
+ 29 => RE_Set_29,
+ 30 => RE_Set_30,
+ 31 => RE_Set_31,
+ 32 => RE_Null,
+ 33 => RE_Set_33,
+ 34 => RE_Set_34,
+ 35 => RE_Set_35,
+ 36 => RE_Set_36,
+ 37 => RE_Set_37,
+ 38 => RE_Set_38,
+ 39 => RE_Set_39,
+ 40 => RE_Set_40,
+ 41 => RE_Set_41,
+ 42 => RE_Set_42,
+ 43 => RE_Set_43,
+ 44 => RE_Set_44,
+ 45 => RE_Set_45,
+ 46 => RE_Set_46,
+ 47 => RE_Set_47,
+ 48 => RE_Set_48,
+ 49 => RE_Set_49,
+ 50 => RE_Set_50,
+ 51 => RE_Set_51,
+ 52 => RE_Set_52,
+ 53 => RE_Set_53,
+ 54 => RE_Set_54,
+ 55 => RE_Set_55,
+ 56 => RE_Set_56,
+ 57 => RE_Set_57,
+ 58 => RE_Set_58,
+ 59 => RE_Set_59,
+ 60 => RE_Set_60,
+ 61 => RE_Set_61,
+ 62 => RE_Set_62,
+ 63 => RE_Set_63);
+
+ -- Array of Set routine entities to be used in the case where the packed
+ -- array is itself a component of a packed structure, and therefore may not
+ -- be fully aligned. This only affects the even sizes, since for the odd
+ -- sizes, we do not get any fixed alignment in any case.
+
+ SetU_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Set_03,
+ 04 => RE_Null,
+ 05 => RE_Set_05,
+ 06 => RE_SetU_06,
+ 07 => RE_Set_07,
+ 08 => RE_Null,
+ 09 => RE_Set_09,
+ 10 => RE_SetU_10,
+ 11 => RE_Set_11,
+ 12 => RE_SetU_12,
+ 13 => RE_Set_13,
+ 14 => RE_SetU_14,
+ 15 => RE_Set_15,
+ 16 => RE_Null,
+ 17 => RE_Set_17,
+ 18 => RE_SetU_18,
+ 19 => RE_Set_19,
+ 20 => RE_SetU_20,
+ 21 => RE_Set_21,
+ 22 => RE_SetU_22,
+ 23 => RE_Set_23,
+ 24 => RE_SetU_24,
+ 25 => RE_Set_25,
+ 26 => RE_SetU_26,
+ 27 => RE_Set_27,
+ 28 => RE_SetU_28,
+ 29 => RE_Set_29,
+ 30 => RE_SetU_30,
+ 31 => RE_Set_31,
+ 32 => RE_Null,
+ 33 => RE_Set_33,
+ 34 => RE_SetU_34,
+ 35 => RE_Set_35,
+ 36 => RE_SetU_36,
+ 37 => RE_Set_37,
+ 38 => RE_SetU_38,
+ 39 => RE_Set_39,
+ 40 => RE_SetU_40,
+ 41 => RE_Set_41,
+ 42 => RE_SetU_42,
+ 43 => RE_Set_43,
+ 44 => RE_SetU_44,
+ 45 => RE_Set_45,
+ 46 => RE_SetU_46,
+ 47 => RE_Set_47,
+ 48 => RE_SetU_48,
+ 49 => RE_Set_49,
+ 50 => RE_SetU_50,
+ 51 => RE_Set_51,
+ 52 => RE_SetU_52,
+ 53 => RE_Set_53,
+ 54 => RE_SetU_54,
+ 55 => RE_Set_55,
+ 56 => RE_SetU_56,
+ 57 => RE_Set_57,
+ 58 => RE_SetU_58,
+ 59 => RE_Set_59,
+ 60 => RE_SetU_60,
+ 61 => RE_Set_61,
+ 62 => RE_SetU_62,
+ 63 => RE_Set_63);
+
-----------------
-- Subprograms --
-----------------
===================================================================
@@ -128,6 +128,60 @@
-- The field First_Implicit_With in the unit table record are used to
-- avoid creating duplicate with_clauses.
+ ----------------------------------------------
+ -- Table of Predefined RE_Id Error Messages --
+ ----------------------------------------------
+
+ -- If an attempt is made to load an entity, given an RE_Id value, and the
+ -- entity is not available in the current configuration, an error message
+ -- is given (see Entity_Not_Defined below). The general form of such an
+ -- error message is for example:
+
+ -- entity "System.Pack_43.Bits_43" not defined
+
+ -- The following table defines a set of RE_Id image values for which this
+ -- error message is specialized and replaced by specific text indicating
+ -- the exact message to be output. For example, in the case above, for the
+ -- RE_Id value RE_Bits_43, we do indeed specialize the message, and the
+ -- above generic message is replaced by:
+
+ -- packed component size of 43 is not supported
+
+ type CString_Ptr is access constant String;
+
+ type PRE_Id_Entry is record
+ Str : CString_Ptr;
+ -- Pointer to string with the RE_Id image. The sequence ?? may appear
+ -- in which case it will match any characters in the RE_Id image value.
+ -- This is used to avoid the need for dozens of entries for RE_Bits_??.
+
+ Msg : CString_Ptr;
+ -- Pointer to string with the corresponding error text. The sequence
+ -- ?? may appear, in which case, it is replaced by the corresponding
+ -- sequence ?? in the Str value (if the first ? is zero, then it is
+ -- omitted from the message).
+ end record;
+
+ Str1 : aliased constant String := "RE_BITS_??";
+ Str2 : aliased constant String := "RE_GET_??";
+ Str3 : aliased constant String := "RE_SET_??";
+ Str4 : aliased constant String := "RE_CALL_SIMPLE";
+
+ MsgPack : aliased constant String :=
+ "packed component size of ?? is not supported";
+ MsgRV : aliased constant String :=
+ "task rendezvous is not supported";
+
+ PRE_Id_Table : constant array (Natural range <>) of PRE_Id_Entry :=
+ (1 => (Str1'Access, MsgPack'Access),
+ 2 => (Str2'Access, MsgPack'Access),
+ 3 => (Str3'Access, MsgPack'Access),
+ 4 => (Str4'Access, MsgRV'Access));
+ -- We will add entries to this table as we find cases where it is a good
+ -- idea to do so. By no means all the RE_Id values need entries, because
+ -- the expander often gives clear messages before it makes the Rtsfind
+ -- call expecting to find the entity.
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -141,7 +195,8 @@
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the run-time
-- library (the form of the error message is tailored for no run time or
- -- configurable run time mode as required).
+ -- configurable run time mode as required). See also table of pre-defined
+ -- messages for entities above (RE_Id_Messages).
function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
-- Retrieves the Unit Name given a unit id represented by its enumeration
@@ -191,8 +246,7 @@
procedure Output_Entity_Name (Id : RE_Id; Msg : String);
-- Output continuation error message giving qualified name of entity
- -- corresponding to Id, appending the string given by Msg. This call
- -- is only effective in All_Errors mode.
+ -- corresponding to Id, appending the string given by Msg.
function RE_Chars (E : RE_Id) return Name_Id;
-- Given a RE_Id value returns the Chars of the corresponding entity
@@ -432,6 +486,54 @@
RTE_Error_Msg ("run-time configuration error");
end if;
+ -- See if this entry is to be found in the PRE_Id table that provides
+ -- specialized messages for some RE_Id values.
+
+ for J in PRE_Id_Table'Range loop
+ declare
+ TStr : constant String := PRE_Id_Table (J).Str.all;
+ RStr : constant String := RE_Id'Image (Id);
+ TMsg : String := PRE_Id_Table (J).Msg.all;
+ LMsg : Natural := TMsg'Length;
+
+ begin
+ if TStr'Length = RStr'Length then
+ for J in TStr'Range loop
+ if TStr (J) /= RStr (J) and then TStr (J) /= '?' then
+ goto Continue;
+ end if;
+ end loop;
+
+ for J in TMsg'First .. TMsg'Last - 1 loop
+ if TMsg (J) = '?' then
+ for K in 1 .. TStr'Last loop
+ if TStr (K) = '?' then
+ if RStr (K) = '0' then
+ TMsg (J) := RStr (K + 1);
+ TMsg (J + 1 .. LMsg - 1) := TMsg (J + 2 .. LMsg);
+ LMsg := LMsg - 1;
+ else
+ TMsg (J .. J + 1) := RStr (K .. K + 1);
+ end if;
+
+ exit;
+ end if;
+ end loop;
+ end if;
+ end loop;
+
+ RTE_Error_Msg (TMsg (1 .. LMsg));
+ return;
+ end if;
+ end;
+
+ <<Continue>> null;
+ end loop;
+
+ -- We did not find an entry in the table, so output the generic entity
+ -- not found message, where the name of the entity corresponds to the
+ -- given RE_Id value.
+
Output_Entity_Name (Id, "not defined");
end Entity_Not_Defined;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
@@ -1662,6 +1662,15 @@
Image_Out (Input, True, Format);
end UI_Image;
+ function UI_Image
+ (Input : Uint;
+ Format : UI_Format := Auto) return String
+ is
+ begin
+ Image_Out (Input, True, Format);
+ return UI_Image_Buffer (1 .. UI_Image_Length);
+ end UI_Image;
+
-------------------------
-- UI_Is_In_Int_Range --
-------------------------
===================================================================
@@ -2370,6 +2370,24 @@
Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
Set_Is_Bit_Packed_Array (Base_Type (Arr), True);
Set_Is_Packed (Base_Type (Arr), True);
+
+ -- Make sure that we have the necessary routines to
+ -- implement the packing, and complain now if not.
+
+ declare
+ CS : constant Int := UI_To_Int (Csiz);
+ RE : constant RE_Id := Get_Id (CS);
+
+ begin
+ if RE /= RE_Null
+ and then not RTE_Available (RE)
+ then
+ Error_Msg_CRT
+ ("packing of " & UI_Image (Csiz)
+ & "-bit components",
+ First_Subtype (Etype (Arr)));
+ end if;
+ end;
end if;
end;
end if;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
@@ -299,11 +299,16 @@
-- followed by the value in UI_Image_Buffer. The form of the value is an
-- integer literal in either decimal (no base) or hexadecimal (base 16)
-- format. If Hex is True on entry, then hex mode is forced, otherwise
- -- UI_Image makes a guess at which output format is more convenient.
- -- The value must fit in UI_Image_Buffer. If necessary, the result is an
- -- approximation of the proper value, using an exponential format. The
- -- image of No_Uint is output as a single question mark.
+ -- UI_Image makes a guess at which output format is more convenient. The
+ -- value must fit in UI_Image_Buffer. The actual length of the result is
+ -- returned in UI_Image_Length. If necessary to meet this requirement, the
+ -- result is an approximation of the proper value, using an exponential
+ -- format. The image of No_Uint is output as a single question mark.
+ function UI_Image (Input : Uint; Format : UI_Format := Auto) return String;
+ -- Functional form, in which the result is returned as a string. This call
+ -- also leaves the result in UI_Image_Buffer/Length as described above.
+
procedure UI_Write (Input : Uint; Format : UI_Format := Auto);
-- Writes a representation of Uint, consisting of a possible minus sign,
-- followed by the value to the output file. The form of the value is an
A new mechanism has been implemented that allows specialization of error messages for missing entities in a configurable run-time. Instead of just outputting the (sometimes obscure) name of the entity involved, a more meaningful message can be issued. This new mechanism is used for a case of rendezvous not being supported and also for packed array operations not being supported. Also in the case of unsupported array packing, the message is now issued explicitly on the array type entity, as shown in this test program (compiled with -gnatld7 -gnatj55) 1. pragma No_Run_Time; 2. procedure BadPack (M : Integer) is 3. type R is mod 2 ** 43; 4. type A is array (1 .. 10) of R; | >>> packing of 43-bit components not allowed in no run time mode 5. pragma Pack (A); 6. AV : A; 7. begin 8. AV (M) := 3; | >>> construct not allowed in no run time mode >>> packed component size of 43 is not supported 9. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2014-10-17 Robert Dewar <dewar@adacore.com> * exp_pakd.adb: Move bit packed entity tables to spec. * exp_pakd.ads: Move bit packed entity tables here from body. * freeze.adb (Freeze_Array_Type): Check that packed array type is supported. * rtsfind.adb (PRE_Id_Table): New table (Entity_Not_Defined): Specialize messages using PRE_Id_Table. * uintp.ads, uintp.adb (UI_Image): New functional form.