s-oscons-tmplt.c, [...]: Add new constants in preparation for sharing s-crtl across all platforms.

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c, xoscons.adb: Add new constants in preparation for
	sharing s-crtl across all platforms.

From-SVN: r154760

3 files changed, 92 insertions, 19 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ec4250c..16b8670 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
 2009-11-30  Thomas Quinot  <quinot@adacore.com>
 
+	* s-oscons-tmplt.c, xoscons.adb: Add new constants in preparation for
+	sharing s-crtl across all platforms.
+
+2009-11-30  Thomas Quinot  <quinot@adacore.com>
+
 	* s-commun.adb, s-commun.ads: New internal support unit,
 	allowing code sharing between GNAT.Sockets and
 	GNAT.Serial_Communication.
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 48938d9..3771f4c 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -161,6 +161,9 @@ int counter = 0;
 #define CNS(name,comment) \
   printf ("\n->CNS:$%d:" #name ":" name ":" comment, __LINE__);
 
+#define C(sname,type,value,comment)\
+  printf ("\n->C:$%d:" sname ":" #type ":" value ":" comment, __LINE__);
+
 #define TXT(text) \
   printf ("\n->TXT:$%d:" text, __LINE__);
 
@@ -174,7 +177,12 @@ int counter = 0;
 #define CNS(name, comment) \
   asm volatile("\n->CNS:%0:" #name ":" name ":" comment \
   : : "i" (__LINE__));
-/* General expression constant */
+/* General expression named number */
+
+#define C(sname, type, value, comment) \
+  asm volatile("\n->C:%0:" sname ":" #type ":" value ":" comment \
+  : : "i" (__LINE__));
+/* Typed constant */
 
 #define TXT(text) \
   asm volatile("\n->TXT:%0:" text \
@@ -183,6 +191,8 @@ int counter = 0;
 
 #endif
 
+#define CST(name,comment) C(#name,String,name,comment)
+
 #define STR(x) STR1(x)
 #define STR1(x) #x
 
@@ -233,10 +243,7 @@ package System.OS_Constants is
    -- Platform identification --
    -----------------------------
 
-*/
-TXT("   Target_Name : constant String := " STR(TARGET) ";")
-/*
-   type Target_OS_Type is (Windows, VMS, Other_OS);
+   type OS_Type is (Windows, VMS, Other_OS);
 */
 #if defined (__MINGW32__)
 # define TARGET_OS "Windows"
@@ -245,7 +252,9 @@ TXT("   Target_Name : constant String := " STR(TARGET) ";")
 #else
 # define TARGET_OS "Other_OS"
 #endif
-TXT("   Target_OS : constant Target_OS_Type := " TARGET_OS ";")
+C("Target_OS", OS_Type, TARGET_OS, "")
+#define Target_Name TARGET
+CST(Target_Name, "")
 /*
 
    -------------------
@@ -1251,7 +1260,7 @@ CND(Has_Sockaddr_Len,  "Sockaddr has sa_len field")
  ** Do not change the format of the line below without also updating the
  ** MaRTE Makefile.
  **/
-TXT("   Thread_Blocking_IO  : constant Boolean := True;")
+C("Thread_Blocking_IO", Boolean, "True", "")
 /*
    --  Set False for contexts where socket i/o are process blocking
 
@@ -1262,10 +1271,31 @@ TXT("   Thread_Blocking_IO  : constant Boolean := True;")
 #else
 # define Inet_Pton_Linkname "__gnat_inet_pton"
 #endif
-TXT("   Inet_Pton_Linkname  : constant String := \"" Inet_Pton_Linkname "\";")
+CST(Inet_Pton_Linkname, "")
 
 #endif /* HAVE_SOCKETS */
 
+/*
+
+   ---------------------------------
+   -- C runtime library interface --
+   ---------------------------------
+
+*/
+#if defined (__VMS)
+# define malloc32_Linkname  "_malloc32"
+# define realloc32_Linkname "_realloc32"
+# define strerror_Linkname  "DECC$STRERROR"
+#else
+# define malloc32_Linkname  "malloc"
+# define realloc32_Linkname "realloc"
+# define strerror_Linkname  "strerror"
+#endif
+
+CST(malloc32_Linkname, "")
+CST(realloc32_Linkname, "")
+CST(strerror_Linkname, "")
+
 /**
  **  System-specific constants follow
  **  Each section should be activated if compiling for the corresponding
diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb
index 83b726b..afe05ef 100644
--- a/gcc/ada/xoscons.adb
+++ b/gcc/ada/xoscons.adb
@@ -72,12 +72,15 @@ procedure XOSCons is
    end record;
 
    type Asm_Info_Kind is
-     (CND,     --  Constant (decimal)
-      CNS,     --  Constant (freeform string)
+     (CND,     --  Named number (decimal)
+      CNS,     --  Named number (freeform text)
+      C,       --  Constant object
       TXT);    --  Literal text
    --  Recognized markers found in assembly file. These markers are produced by
    --  the same-named macros from the C template.
 
+   subtype Named_Number is Asm_Info_Kind range CND .. CNS;
+
    type Asm_Info (Kind : Asm_Info_Kind := TXT) is record
       Line_Number   : Integer;
       --  Line number in C source file
@@ -85,11 +88,14 @@ procedure XOSCons is
       Constant_Name : String_Access;
       --  Name of constant to be defined
 
+      Constant_Type : String_Access;
+      --  Type of constant (case of Kind = C)
+
       Value_Len     : Natural := 0;
       --  Length of text representation of constant's value
 
       Text_Value    : String_Access;
-      --  Value for CNS constant
+      --  Value for CNS / C constant
 
       Int_Value     : Int_Value_Type;
       --  Value for CND constant
@@ -105,8 +111,9 @@ procedure XOSCons is
       Table_Initial        => 100,
       Table_Increment      => 10);
 
-   Max_Const_Name_Len     : Natural := 0;
+   Max_Constant_Name_Len  : Natural := 0;
    Max_Constant_Value_Len : Natural := 0;
+   Max_Constant_Type_Len  : Natural := 0;
    --  Lengths of longest name and longest value
 
    type Language is (Lang_Ada, Lang_C);
@@ -170,13 +177,22 @@ procedure XOSCons is
          case Lang is
             when Lang_Ada =>
                Put ("   " & Info.Constant_Name.all);
-               Put (Spaces (Max_Const_Name_Len - Info.Constant_Name'Length));
+               Put (Spaces (Max_Constant_Name_Len
+                              - Info.Constant_Name'Length));
 
-               Put (" : constant := ");
+               if Info.Kind in Named_Number then
+                  Put (" : constant := ");
+               else
+                  Put (" : constant " & Info.Constant_Type.all);
+                  Put (Spaces (Max_Constant_Type_Len
+                                 - Info.Constant_Type'Length));
+                  Put (" := ");
+               end if;
 
             when Lang_C =>
                Put ("#define " & Info.Constant_Name.all & " ");
-               Put (Spaces (Max_Const_Name_Len - Info.Constant_Name'Length));
+               Put (Spaces (Max_Constant_Name_Len
+                              - Info.Constant_Name'Length));
          end case;
 
          if Info.Kind = CND then
@@ -185,7 +201,19 @@ procedure XOSCons is
             end if;
             Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
          else
-            Put (Info.Text_Value.all);
+            declare
+               Is_String : constant Boolean :=
+                             Info.Kind = C
+                               and then Info.Constant_Type.all = "String";
+            begin
+               if Is_String then
+                  Put ("""");
+               end if;
+               Put (Info.Text_Value.all);
+               if Is_String then
+                  Put ("""");
+               end if;
+            end;
          end if;
 
          if Lang = Lang_Ada then
@@ -290,18 +318,28 @@ procedure XOSCons is
            Integer (Parse_Int (Line (Index1 .. Index2 - 1)).Abs_Value);
 
          case Info.Kind is
-            when CND | CNS =>
+            when CND | CNS | C =>
                Index1 := Index2 + 1;
                Find_Colon (Index2);
 
                Info.Constant_Name := Field_Alloc;
-               if Info.Constant_Name'Length > Max_Const_Name_Len then
-                  Max_Const_Name_Len := Info.Constant_Name'Length;
+               if Info.Constant_Name'Length > Max_Constant_Name_Len then
+                  Max_Constant_Name_Len := Info.Constant_Name'Length;
                end if;
 
                Index1 := Index2 + 1;
                Find_Colon (Index2);
 
+               if Info.Kind = C then
+                  Info.Constant_Type := Field_Alloc;
+                  if Info.Constant_Type'Length > Max_Constant_Type_Len then
+                     Max_Constant_Type_Len := Info.Constant_Type'Length;
+                  end if;
+
+                  Index1 := Index2 + 1;
+                  Find_Colon (Index2);
+               end if;
+
                if Info.Kind = CND then
                   Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1));
                   Info.Value_Len := Index2 - Index1 - 1;