Commit cd4de820 by Thomas Quinot Committed by Arnaud Charlet

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
parent 7aec2c63
2009-11-30 Thomas Quinot <quinot@adacore.com> 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, * s-commun.adb, s-commun.ads: New internal support unit,
allowing code sharing between GNAT.Sockets and allowing code sharing between GNAT.Sockets and
GNAT.Serial_Communication. GNAT.Serial_Communication.
......
...@@ -161,6 +161,9 @@ int counter = 0; ...@@ -161,6 +161,9 @@ int counter = 0;
#define CNS(name,comment) \ #define CNS(name,comment) \
printf ("\n->CNS:$%d:" #name ":" name ":" comment, __LINE__); 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) \ #define TXT(text) \
printf ("\n->TXT:$%d:" text, __LINE__); printf ("\n->TXT:$%d:" text, __LINE__);
...@@ -174,7 +177,12 @@ int counter = 0; ...@@ -174,7 +177,12 @@ int counter = 0;
#define CNS(name, comment) \ #define CNS(name, comment) \
asm volatile("\n->CNS:%0:" #name ":" name ":" comment \ asm volatile("\n->CNS:%0:" #name ":" name ":" comment \
: : "i" (__LINE__)); : : "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) \ #define TXT(text) \
asm volatile("\n->TXT:%0:" text \ asm volatile("\n->TXT:%0:" text \
...@@ -183,6 +191,8 @@ int counter = 0; ...@@ -183,6 +191,8 @@ int counter = 0;
#endif #endif
#define CST(name,comment) C(#name,String,name,comment)
#define STR(x) STR1(x) #define STR(x) STR1(x)
#define STR1(x) #x #define STR1(x) #x
...@@ -233,10 +243,7 @@ package System.OS_Constants is ...@@ -233,10 +243,7 @@ package System.OS_Constants is
-- Platform identification -- -- Platform identification --
----------------------------- -----------------------------
*/ type OS_Type is (Windows, VMS, Other_OS);
TXT(" Target_Name : constant String := " STR(TARGET) ";")
/*
type Target_OS_Type is (Windows, VMS, Other_OS);
*/ */
#if defined (__MINGW32__) #if defined (__MINGW32__)
# define TARGET_OS "Windows" # define TARGET_OS "Windows"
...@@ -245,7 +252,9 @@ TXT(" Target_Name : constant String := " STR(TARGET) ";") ...@@ -245,7 +252,9 @@ TXT(" Target_Name : constant String := " STR(TARGET) ";")
#else #else
# define TARGET_OS "Other_OS" # define TARGET_OS "Other_OS"
#endif #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") ...@@ -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 ** Do not change the format of the line below without also updating the
** MaRTE Makefile. ** 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 -- Set False for contexts where socket i/o are process blocking
...@@ -1262,10 +1271,31 @@ TXT(" Thread_Blocking_IO : constant Boolean := True;") ...@@ -1262,10 +1271,31 @@ TXT(" Thread_Blocking_IO : constant Boolean := True;")
#else #else
# define Inet_Pton_Linkname "__gnat_inet_pton" # define Inet_Pton_Linkname "__gnat_inet_pton"
#endif #endif
TXT(" Inet_Pton_Linkname : constant String := \"" Inet_Pton_Linkname "\";") CST(Inet_Pton_Linkname, "")
#endif /* HAVE_SOCKETS */ #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 ** System-specific constants follow
** Each section should be activated if compiling for the corresponding ** Each section should be activated if compiling for the corresponding
......
...@@ -72,12 +72,15 @@ procedure XOSCons is ...@@ -72,12 +72,15 @@ procedure XOSCons is
end record; end record;
type Asm_Info_Kind is type Asm_Info_Kind is
(CND, -- Constant (decimal) (CND, -- Named number (decimal)
CNS, -- Constant (freeform string) CNS, -- Named number (freeform text)
C, -- Constant object
TXT); -- Literal text TXT); -- Literal text
-- Recognized markers found in assembly file. These markers are produced by -- Recognized markers found in assembly file. These markers are produced by
-- the same-named macros from the C template. -- 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 type Asm_Info (Kind : Asm_Info_Kind := TXT) is record
Line_Number : Integer; Line_Number : Integer;
-- Line number in C source file -- Line number in C source file
...@@ -85,11 +88,14 @@ procedure XOSCons is ...@@ -85,11 +88,14 @@ procedure XOSCons is
Constant_Name : String_Access; Constant_Name : String_Access;
-- Name of constant to be defined -- Name of constant to be defined
Constant_Type : String_Access;
-- Type of constant (case of Kind = C)
Value_Len : Natural := 0; Value_Len : Natural := 0;
-- Length of text representation of constant's value -- Length of text representation of constant's value
Text_Value : String_Access; Text_Value : String_Access;
-- Value for CNS constant -- Value for CNS / C constant
Int_Value : Int_Value_Type; Int_Value : Int_Value_Type;
-- Value for CND constant -- Value for CND constant
...@@ -105,8 +111,9 @@ procedure XOSCons is ...@@ -105,8 +111,9 @@ procedure XOSCons is
Table_Initial => 100, Table_Initial => 100,
Table_Increment => 10); Table_Increment => 10);
Max_Const_Name_Len : Natural := 0; Max_Constant_Name_Len : Natural := 0;
Max_Constant_Value_Len : Natural := 0; Max_Constant_Value_Len : Natural := 0;
Max_Constant_Type_Len : Natural := 0;
-- Lengths of longest name and longest value -- Lengths of longest name and longest value
type Language is (Lang_Ada, Lang_C); type Language is (Lang_Ada, Lang_C);
...@@ -170,13 +177,22 @@ procedure XOSCons is ...@@ -170,13 +177,22 @@ procedure XOSCons is
case Lang is case Lang is
when Lang_Ada => when Lang_Ada =>
Put (" " & Info.Constant_Name.all); 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));
if Info.Kind in Named_Number then
Put (" : constant := "); 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 => when Lang_C =>
Put ("#define " & Info.Constant_Name.all & " "); 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; end case;
if Info.Kind = CND then if Info.Kind = CND then
...@@ -185,7 +201,19 @@ procedure XOSCons is ...@@ -185,7 +201,19 @@ procedure XOSCons is
end if; end if;
Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left)); Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
else else
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); Put (Info.Text_Value.all);
if Is_String then
Put ("""");
end if;
end;
end if; end if;
if Lang = Lang_Ada then if Lang = Lang_Ada then
...@@ -290,18 +318,28 @@ procedure XOSCons is ...@@ -290,18 +318,28 @@ procedure XOSCons is
Integer (Parse_Int (Line (Index1 .. Index2 - 1)).Abs_Value); Integer (Parse_Int (Line (Index1 .. Index2 - 1)).Abs_Value);
case Info.Kind is case Info.Kind is
when CND | CNS => when CND | CNS | C =>
Index1 := Index2 + 1; Index1 := Index2 + 1;
Find_Colon (Index2); Find_Colon (Index2);
Info.Constant_Name := Field_Alloc; Info.Constant_Name := Field_Alloc;
if Info.Constant_Name'Length > Max_Const_Name_Len then if Info.Constant_Name'Length > Max_Constant_Name_Len then
Max_Const_Name_Len := Info.Constant_Name'Length; Max_Constant_Name_Len := Info.Constant_Name'Length;
end if; end if;
Index1 := Index2 + 1; Index1 := Index2 + 1;
Find_Colon (Index2); 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 if Info.Kind = CND then
Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1)); Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1));
Info.Value_Len := Index2 - Index1 - 1; Info.Value_Len := Index2 - Index1 - 1;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment