Skip to content

R
riscv-gcc-1
Commit ffec8e81 by Arnaud Charlet
Options

[multiple changes] 

2009-04-17  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os.

2009-04-17  Pascal Obry  <obry@adacore.com>

	* mingw32.h: Add S2WSC and WS2SC macros to convert to/from
	CurrentCodePage.

	* adaint.h: Encoding_Unspecified is now defined. Corresponds to the
	value when no encoding form paramter is set on Text_IO services.

	* adaint.c: CurrentCodePage new variable on Windows.
	Use new macros S2WSC and WS2SC instead of the UTF-8 oriented
	ones.

	* mkdir.c: Use new macros S2WSC and WS2SC instead of the UTF-8 oriented
	ones.

	* initialize.c: Initialize CurrentCodePage depending on GNAT_CODE_PAGE
	environment variable value. Default is UTF-8.

	* s-crtl.ads: Filename_Encoding add Unspecified in the enumeration type.
	fopen and freopen encoding parameter is now set to Unspecified.
	The default value is in this case UTF-8 (as it was before) but
	use the new macros that convert to/from the code page set
	at runtime (CurrentCodePage).

	* s-fileio.adb: When no encoding specified use Unspecified value.

2009-04-17  Ed Schonberg  <schonberg@adacore.com>

	* atree.adb, atree.ads: Remove dead code.

From-SVN: r146235
parent 432e3422
Showing with 115 additions and 1058 deletions
gcc/ada/ChangeLog
2009-04-17 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os.
2009-04-17 Pascal Obry <obry@adacore.com>
* mingw32.h: Add S2WSC and WS2SC macros to convert to/from
CurrentCodePage.
* adaint.h: Encoding_Unspecified is now defined. Corresponds to the
value when no encoding form paramter is set on Text_IO services.
* adaint.c: CurrentCodePage new variable on Windows.
Use new macros S2WSC and WS2SC instead of the UTF-8 oriented
ones.
* mkdir.c: Use new macros S2WSC and WS2SC instead of the UTF-8 oriented
ones.
* initialize.c: Initialize CurrentCodePage depending on GNAT_CODE_PAGE
environment variable value. Default is UTF-8.
* s-crtl.ads: Filename_Encoding add Unspecified in the enumeration type.
fopen and freopen encoding parameter is now set to Unspecified.
The default value is in this case UTF-8 (as it was before) but
use the new macros that convert to/from the code page set
at runtime (CurrentCodePage).
* s-fileio.adb: When no encoding specified use Unspecified value.
2009-04-17 Ed Schonberg <schonberg@adacore.com>
* atree.adb, atree.ads: Remove dead code.
2009-04-17 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies.
gcc/ada/adaint.c
......@@ -82,6 +82,9 @@
#include <Rtapi.h>
#else
#include "mingw32.h"
/* Current code page to use, set in initialize.c. */
UINT CurrentCodePage;
#endif
#include <sys/utime.h>
......@@ -482,8 +485,8 @@ __gnat_try_lock (char *dir, char *file)
TCHAR wfile[GNAT_MAX_PATH_LEN];
TCHAR wdir[GNAT_MAX_PATH_LEN];
S2WSU (wdir, dir, GNAT_MAX_PATH_LEN);
S2WSU (wfile, file, GNAT_MAX_PATH_LEN);
S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
_stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
......@@ -585,7 +588,7 @@ __gnat_get_current_dir (char *dir, int *length)
_tgetcwd (wdir, *length);
WS2SU (dir, wdir, GNAT_MAX_PATH_LEN);
WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
#elif defined (VMS)
/* Force Unix style, which is what GNAT uses internally. */
......@@ -662,7 +665,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
char *encoding ATTRIBUTE_UNUSED, int *e_length)
{
#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
WS2SU (os_name, (TCHAR *)w_filename, o_length);
WS2SC (os_name, (TCHAR *)w_filename, o_length);
*o_length = strlen (os_name);
strcpy (encoding, "encoding=utf8");
*e_length = strlen (encoding);
......@@ -682,7 +685,7 @@ __gnat_unlink (char *path)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _tunlink (wpath);
}
#else
......@@ -699,8 +702,8 @@ __gnat_rename (char *from, char *to)
{
TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
S2WSU (wfrom, from, GNAT_MAX_PATH_LEN);
S2WSU (wto, to, GNAT_MAX_PATH_LEN);
S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
S2WSC (wto, to, GNAT_MAX_PATH_LEN);
return _trename (wfrom, wto);
}
#else
......@@ -717,7 +720,7 @@ __gnat_chdir (char *path)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _tchdir (wpath);
}
#else
......@@ -734,7 +737,7 @@ __gnat_rmdir (char *path)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
return _trmdir (wpath);
}
#else
......@@ -751,7 +754,9 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
S2WS (wmode, mode, 10);
if (encoding == Encoding_UTF8)
if (encoding == Encoding_Unspecified)
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
else if (encoding == Encoding_UTF8)
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
else
S2WS (wpath, path, GNAT_MAX_PATH_LEN);
......@@ -773,7 +778,9 @@ __gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNU
S2WS (wmode, mode, 10);
if (encoding == Encoding_UTF8)
if (encoding == Encoding_Unspecified)
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
else if (encoding == Encoding_UTF8)
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
else
S2WS (wpath, path, GNAT_MAX_PATH_LEN);
......@@ -805,7 +812,7 @@ __gnat_open_read (char *path, int fmode)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
}
#else
......@@ -846,7 +853,7 @@ __gnat_open_rw (char *path, int fmode)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_RDWR | o_fmode, PERM);
}
#else
......@@ -872,7 +879,7 @@ __gnat_open_create (char *path, int fmode)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
}
#else
......@@ -894,7 +901,7 @@ __gnat_create_output_file (char *path)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
}
#else
......@@ -920,7 +927,7 @@ __gnat_open_append (char *path, int fmode)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
}
#else
......@@ -948,7 +955,7 @@ __gnat_open_new (char *path, int fmode)
{
TCHAR wpath[GNAT_MAX_PATH_LEN];
S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
}
#else
......@@ -1101,7 +1108,7 @@ DIR* __gnat_opendir (char *name)
#elif defined (__MINGW32__)
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSU (wname, name, GNAT_MAX_PATH_LEN);
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
return (DIR*)_topendir (wname);
#else
......@@ -1125,7 +1132,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len)
if (dirent != NULL)
{
WS2SU (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
*len = strlen (buffer);
return buffer;
......@@ -1231,7 +1238,7 @@ __gnat_file_time_name (char *name)
time_t ret = -1;
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSU (wname, name, GNAT_MAX_PATH_LEN);
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
HANDLE h = CreateFile
(wname, GENERIC_READ, FILE_SHARE_READ, 0,
......@@ -1368,7 +1375,7 @@ __gnat_set_file_time_name (char *name, time_t time_stamp)
} t_write;
TCHAR wname[GNAT_MAX_PATH_LEN];
S2WSU (wname, name, GNAT_MAX_PATH_LEN);
S2WSC (wname, name, GNAT_MAX_PATH_LEN);
HANDLE h = CreateFile
(wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
......@@ -1631,7 +1638,7 @@ __gnat_stat (char *name, struct stat *statbuf)
int name_len;
TCHAR last_char;
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
name_len = _tcslen (wname);
if (name_len > GNAT_MAX_PATH_LEN)
......@@ -1667,7 +1674,7 @@ __gnat_file_exists (char *name)
offset the _stat() routine fails on specific files like CON: */
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
struct stat statbuf;
......@@ -1851,7 +1858,7 @@ __gnat_is_readable_file (char *name)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericRead = GENERIC_READ;
......@@ -1875,7 +1882,7 @@ __gnat_is_writable_file (char *name)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericWrite = GENERIC_WRITE;
......@@ -1901,7 +1908,7 @@ __gnat_is_executable_file (char *name)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
GENERIC_MAPPING GenericMapping;
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
GenericMapping.GenericExecute = GENERIC_EXECUTE;
......@@ -1924,7 +1931,7 @@ __gnat_set_writable (char *name)
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
SetFileAttributes
......@@ -1946,7 +1953,7 @@ __gnat_set_executable (char *name)
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
......@@ -1966,7 +1973,7 @@ __gnat_set_non_writable (char *name)
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL
(wname, DENY_ACCESS,
......@@ -1991,7 +1998,7 @@ __gnat_set_readable (char *name)
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
......@@ -2010,7 +2017,7 @@ __gnat_set_non_readable (char *name)
#if defined (_WIN32) && !defined (RTX)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
......@@ -2285,7 +2292,7 @@ win32_no_block_spawn (char *command, char *args[])
int wsize = csize * 2;
TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
S2WSU (wcommand, full_command, wsize);
S2WSC (wcommand, full_command, wsize);
free (full_command);
......@@ -2581,7 +2588,7 @@ __gnat_locate_exec_on_path (char *exec_name)
apath_val = alloca (EXPAND_BUFFER_SIZE);
WS2SU (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
return __gnat_locate_exec (exec_name, apath_val);
#else
......
gcc/ada/adaint.h
......@@ -39,8 +39,9 @@
#include <dirent.h>
/* Constants used for the form parameter encoding values */
#define Encoding_UTF8 0
#define Encoding_8bits 1
#define Encoding_UTF8 0 /* UTF-8 */
#define Encoding_8bits 1 /* Standard 8bits, CP_ACP on Windows. */
#define Encoding_Unspecified 2 /* Based on GNAT_CODE_PAGE env variable. */
typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */
......
gcc/ada/atree.adb
......@@ -38,13 +38,10 @@ pragma Style_Checks (All_Checks);
with Debug; use Debug;
with Nlists; use Nlists;
with Elists; use Elists;
with Output; use Output;
with Sinput; use Sinput;
with Tree_IO; use Tree_IO;
with GNAT.HTable; use GNAT.HTable;
package body Atree is
---------------
......@@ -414,35 +411,6 @@ package body Atree is
Table_Increment => Alloc.Orig_Nodes_Increment,
Table_Name => "Orig_Nodes");
----------------------------------------
-- Global_Variables for New_Copy_Tree --
----------------------------------------
-- These global variables are used by New_Copy_Tree. See description
-- of the body of this subprogram for details. Global variables can be
-- safely used by New_Copy_Tree, since there is no case of a recursive
-- call from the processing inside New_Copy_Tree.
NCT_Hash_Threshhold : constant := 20;
-- If there are more than this number of pairs of entries in the
-- map, then Hash_Tables_Used will be set, and the hash tables will
-- be initialized and used for the searches.
NCT_Hash_Tables_Used : Boolean := False;
-- Set to True if hash tables are in use
NCT_Table_Entries : Nat;
-- Count entries in table to see if threshhold is reached
NCT_Hash_Table_Setup : Boolean := False;
-- Set to True if hash table contains data. We set this True if we
-- setup the hash table with data, and leave it set permanently
-- from then on, this is a signal that second and subsequent users
-- of the hash table must clear the old entries before reuse.
subtype NCT_Header_Num is Int range 0 .. 511;
-- Defines range of headers in hash tables (512 headers)
--------------------------
-- Paren_Count Handling --
--------------------------
......@@ -986,12 +954,6 @@ package body Atree is
Dummy := New_Node (N_Error, No_Location);
Set_Name1 (Error, Error_Name);
Set_Error_Posted (Error, True);
-- Set global variables for New_Copy_Tree
NCT_Hash_Tables_Used := False;
NCT_Table_Entries := 0;
NCT_Hash_Table_Setup := False;
end Initialize;
--------------------------
......@@ -1067,940 +1029,6 @@ package body Atree is
return New_Id;
end New_Copy;
-------------------
-- New_Copy_Tree --
-------------------
-- Our approach here requires a two pass traversal of the tree. The
-- first pass visits all nodes that eventually will be copied looking
-- for defining Itypes. If any defining Itypes are found, then they are
-- copied, and an entry is added to the replacement map. In the second
-- phase, the tree is copied, using the replacement map to replace any
-- Itype references within the copied tree.
-- The following hash tables are used if the Map supplied has more
-- than hash threshhold entries to speed up access to the map. If
-- there are fewer entries, then the map is searched sequentially
-- (because setting up a hash table for only a few entries takes
-- more time than it saves.
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num;
-- Hash function used for hash operations
-------------------
-- New_Copy_Hash --
-------------------
function New_Copy_Hash (E : Entity_Id) return NCT_Header_Num is
begin
return Nat (E) mod (NCT_Header_Num'Last + 1);
end New_Copy_Hash;
---------------
-- NCT_Assoc --
---------------
-- The hash table NCT_Assoc associates old entities in the table
-- with their corresponding new entities (i.e. the pairs of entries
-- presented in the original Map argument are Key-Element pairs).
package NCT_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
---------------------
-- NCT_Itype_Assoc --
---------------------
-- The hash table NCT_Itype_Assoc contains entries only for those
-- old nodes which have a non-empty Associated_Node_For_Itype set.
-- The key is the associated node, and the element is the new node
-- itself (NOT the associated node for the new node).
package NCT_Itype_Assoc is new Simple_HTable (
Header_Num => NCT_Header_Num,
Element => Entity_Id,
No_Element => Empty,
Key => Entity_Id,
Hash => New_Copy_Hash,
Equal => Types."=");
-- Start of processing for New_Copy_Tree function
function New_Copy_Tree1
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
New_Scope : Entity_Id := Empty) return Node_Id
is
Actual_Map : Elist_Id := Map;
-- This is the actual map for the copy. It is initialized with the
-- given elements, and then enlarged as required for Itypes that are
-- copied during the first phase of the copy operation. The visit
-- procedures add elements to this map as Itypes are encountered.
-- The reason we cannot use Map directly, is that it may well be
-- (and normally is) initialized to No_Elist, and if we have mapped
-- entities, we have to reset it to point to a real Elist.
function Assoc (N : Node_Or_Entity_Id) return Node_Id;
-- Called during second phase to map entities into their corresponding
-- copies using Actual_Map. If the argument is not an entity, or is not
-- in Actual_Map, then it is returned unchanged.
procedure Build_NCT_Hash_Tables;
-- Builds hash tables (number of elements >= threshold value)
function Copy_Elist_With_Replacement
(Old_Elist : Elist_Id) return Elist_Id;
-- Called during second phase to copy element list doing replacements
procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
-- Called during the second phase to process a copied Itype. The actual
-- copy happened during the first phase (so that we could make the entry
-- in the mapping), but we still have to deal with the descendents of
-- the copied Itype and copy them where necessary.
function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
-- Called during second phase to copy list doing replacements
function Copy_Node_With_Replacement (Old_Node : Node_Id) return Node_Id;
-- Called during second phase to copy node doing replacements
procedure Visit_Elist (E : Elist_Id);
-- Called during first phase to visit all elements of an Elist
procedure Visit_Field (F : Union_Id; N : Node_Id);
-- Visit a single field, recursing to call Visit_Node or Visit_List
-- if the field is a syntactic descendent of the current node (i.e.
-- its parent is Node N).
procedure Visit_Itype (Old_Itype : Entity_Id);
-- Called during first phase to visit subsidiary fields of a defining
-- Itype, and also create a copy and make an entry in the replacement
-- map for the new copy.
procedure Visit_List (L : List_Id);
-- Called during first phase to visit all elements of a List
procedure Visit_Node (N : Node_Or_Entity_Id);
-- Called during first phase to visit a node and all its subtrees
-----------
-- Assoc --
-----------
function Assoc (N : Node_Or_Entity_Id) return Node_Id is
E : Elmt_Id;
Ent : Entity_Id;
begin
if not Has_Extension (N) or else No (Actual_Map) then
return N;
elsif NCT_Hash_Tables_Used then
Ent := NCT_Assoc.Get (Entity_Id (N));
if Present (Ent) then
return Ent;
else
return N;
end if;
-- No hash table used, do serial search
else
E := First_Elmt (Actual_Map);
while Present (E) loop
if Node (E) = N then
return Node (Next_Elmt (E));
else
E := Next_Elmt (Next_Elmt (E));
end if;
end loop;
end if;
return N;
end Assoc;
---------------------------
-- Build_NCT_Hash_Tables --
---------------------------
procedure Build_NCT_Hash_Tables is
Elmt : Elmt_Id;
Ent : Entity_Id;
begin
if NCT_Hash_Table_Setup then
NCT_Assoc.Reset;
NCT_Itype_Assoc.Reset;
end if;
Elmt := First_Elmt (Actual_Map);
while Present (Elmt) loop
Ent := Node (Elmt);
-- Get new entity, and associate old and new
Next_Elmt (Elmt);
NCT_Assoc.Set (Ent, Node (Elmt));
if Is_Type (Ent) then
declare
Anode : constant Entity_Id :=
Associated_Node_For_Itype (Ent);
begin
if Present (Anode) then
-- Enter a link between the associated node of the
-- old Itype and the new Itype, for updating later
-- when node is copied.
NCT_Itype_Assoc.Set (Anode, Node (Elmt));
end if;
end;
end if;
Next_Elmt (Elmt);
end loop;
NCT_Hash_Tables_Used := True;
NCT_Hash_Table_Setup := True;
end Build_NCT_Hash_Tables;
---------------------------------
-- Copy_Elist_With_Replacement --
---------------------------------
function Copy_Elist_With_Replacement
(Old_Elist : Elist_Id) return Elist_Id
is
M : Elmt_Id;
New_Elist : Elist_Id;
begin
if No (Old_Elist) then
return No_Elist;
else
New_Elist := New_Elmt_List;
M := First_Elmt (Old_Elist);
while Present (M) loop
Append_Elmt (Copy_Node_With_Replacement (Node (M)), New_Elist);
Next_Elmt (M);
end loop;
end if;
return New_Elist;
end Copy_Elist_With_Replacement;
---------------------------------
-- Copy_Itype_With_Replacement --
---------------------------------
-- This routine exactly parallels its phase one analog Visit_Itype,
-- and like that routine, knows far too many semantic details about
-- the descendents of Itypes and whether they need copying or not.
procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id) is
begin
-- Translate Next_Entity, Scope and Etype fields, in case they
-- reference entities that have been mapped into copies.
Set_Next_Entity (New_Itype, Assoc (Next_Entity (New_Itype)));
Set_Etype (New_Itype, Assoc (Etype (New_Itype)));
if Present (New_Scope) then
Set_Scope (New_Itype, New_Scope);
else
Set_Scope (New_Itype, Assoc (Scope (New_Itype)));
end if;
-- Copy referenced fields
if Is_Discrete_Type (New_Itype) then
Set_Scalar_Range (New_Itype,
Copy_Node_With_Replacement (Scalar_Range (New_Itype)));
elsif Has_Discriminants (Base_Type (New_Itype)) then
Set_Discriminant_Constraint (New_Itype,
Copy_Elist_With_Replacement
(Discriminant_Constraint (New_Itype)));
elsif Is_Array_Type (New_Itype) then
if Present (First_Index (New_Itype)) then
Set_First_Index (New_Itype,
First (Copy_List_With_Replacement
(List_Containing (First_Index (New_Itype)))));
end if;
if Is_Packed (New_Itype) then
Set_Packed_Array_Type (New_Itype,
Copy_Node_With_Replacement
(Packed_Array_Type (New_Itype)));
end if;
end if;
end Copy_Itype_With_Replacement;
--------------------------------
-- Copy_List_With_Replacement --
--------------------------------
function Copy_List_With_Replacement
(Old_List : List_Id) return List_Id
is
New_List : List_Id;
E : Node_Id;
begin
if Old_List = No_List then
return No_List;
else
New_List := Empty_List;
E := First (Old_List);
while Present (E) loop
Append (Copy_Node_With_Replacement (E), New_List);
Next (E);
end loop;
return New_List;
end if;
end Copy_List_With_Replacement;
--------------------------------
-- Copy_Node_With_Replacement --
--------------------------------
function Copy_Node_With_Replacement
(Old_Node : Node_Id) return Node_Id
is
New_Node : Node_Id;
procedure Adjust_Named_Associations
(Old_Node : Node_Id;
New_Node : Node_Id);
-- If a call node has named associations, these are chained through
-- the First_Named_Actual, Next_Named_Actual links. These must be
-- propagated separately to the new parameter list, because these
-- are not syntactic fields.
function Copy_Field_With_Replacement
(Field : Union_Id) return Union_Id;
-- Given Field, which is a field of Old_Node, return a copy of it
-- if it is a syntactic field (i.e. its parent is Node), setting
-- the parent of the copy to poit to New_Node. Otherwise returns
-- the field (possibly mapped if it is an entity).
-------------------------------
-- Adjust_Named_Associations --
-------------------------------
procedure Adjust_Named_Associations
(Old_Node : Node_Id;
New_Node : Node_Id)
is
Old_E : Node_Id;
New_E : Node_Id;
Old_Next : Node_Id;
New_Next : Node_Id;
begin
Old_E := First (Parameter_Associations (Old_Node));
New_E := First (Parameter_Associations (New_Node));
while Present (Old_E) loop
if Nkind (Old_E) = N_Parameter_Association
and then Present (Next_Named_Actual (Old_E))
then
if First_Named_Actual (Old_Node)
= Explicit_Actual_Parameter (Old_E)
then
Set_First_Named_Actual
(New_Node, Explicit_Actual_Parameter (New_E));
end if;
-- Now scan parameter list from the beginning,to locate
-- next named actual, which can be out of order.
Old_Next := First (Parameter_Associations (Old_Node));
New_Next := First (Parameter_Associations (New_Node));
while Nkind (Old_Next) /= N_Parameter_Association
or else Explicit_Actual_Parameter (Old_Next)
/= Next_Named_Actual (Old_E)
loop
Next (Old_Next);
Next (New_Next);
end loop;
Set_Next_Named_Actual
(New_E, Explicit_Actual_Parameter (New_Next));
end if;
Next (Old_E);
Next (New_E);
end loop;
end Adjust_Named_Associations;
---------------------------------
-- Copy_Field_With_Replacement --
---------------------------------
function Copy_Field_With_Replacement
(Field : Union_Id) return Union_Id
is
begin
if Field = Union_Id (Empty) then
return Field;
elsif Field in Node_Range then
declare
Old_N : constant Node_Id := Node_Id (Field);
New_N : Node_Id;
begin
-- If syntactic field, as indicated by the parent pointer
-- being set, then copy the referenced node recursively.
if Parent (Old_N) = Old_Node then
New_N := Copy_Node_With_Replacement (Old_N);
if New_N /= Old_N then
Set_Parent (New_N, New_Node);
end if;
-- For semantic fields, update possible entity reference
-- from the replacement map.
else
New_N := Assoc (Old_N);
end if;
return Union_Id (New_N);
end;
elsif Field in List_Range then
declare
Old_L : constant List_Id := List_Id (Field);
New_L : List_Id;
begin
-- If syntactic field, as indicated by the parent pointer,
-- then recursively copy the entire referenced list.
if Parent (Old_L) = Old_Node then
New_L := Copy_List_With_Replacement (Old_L);
Set_Parent (New_L, New_Node);
-- For semantic list, just returned unchanged
else
New_L := Old_L;
end if;
return Union_Id (New_L);
end;
-- Anything other than a list or a node is returned unchanged
else
return Field;
end if;
end Copy_Field_With_Replacement;
-- Start of processing for Copy_Node_With_Replacement
begin
if Old_Node <= Empty_Or_Error then
return Old_Node;
elsif Has_Extension (Old_Node) then
return Assoc (Old_Node);
else
New_Node := New_Copy (Old_Node);
-- If the node we are copying is the associated node of a
-- previously copied Itype, then adjust the associated node
-- of the copy of that Itype accordingly.
if Present (Actual_Map) then
declare
E : Elmt_Id;
Ent : Entity_Id;
begin
-- Case of hash table used
if NCT_Hash_Tables_Used then
Ent := NCT_Itype_Assoc.Get (Old_Node);
if Present (Ent) then
Set_Associated_Node_For_Itype (Ent, New_Node);
end if;
-- Case of no hash table used
else
E := First_Elmt (Actual_Map);
while Present (E) loop
if Is_Itype (Node (E))
and then
Old_Node = Associated_Node_For_Itype (Node (E))
then
Set_Associated_Node_For_Itype
(Node (Next_Elmt (E)), New_Node);
end if;
E := Next_Elmt (Next_Elmt (E));
end loop;
end if;
end;
end if;
-- Recursively copy descendents
Set_Field1
(New_Node, Copy_Field_With_Replacement (Field1 (New_Node)));
Set_Field2
(New_Node, Copy_Field_With_Replacement (Field2 (New_Node)));
Set_Field3
(New_Node, Copy_Field_With_Replacement (Field3 (New_Node)));
Set_Field4
(New_Node, Copy_Field_With_Replacement (Field4 (New_Node)));
Set_Field5
(New_Node, Copy_Field_With_Replacement (Field5 (New_Node)));
-- Adjust Sloc of new node if necessary
if New_Sloc /= No_Location then
Set_Sloc (New_Node, New_Sloc);
-- If we adjust the Sloc, then we are essentially making
-- a completely new node, so the Comes_From_Source flag
-- should be reset to the proper default value.
Nodes.Table (New_Node).Comes_From_Source :=
Default_Node.Comes_From_Source;
end if;
-- If the node is call and has named associations,
-- set the corresponding links in the copy.
if (Nkind (Old_Node) = N_Function_Call
or else Nkind (Old_Node) = N_Entry_Call_Statement
or else
Nkind (Old_Node) = N_Procedure_Call_Statement)
and then Present (First_Named_Actual (Old_Node))
then
Adjust_Named_Associations (Old_Node, New_Node);
end if;
-- Reset First_Real_Statement for Handled_Sequence_Of_Statements.
-- The replacement mechanism applies to entities, and is not used
-- here. Eventually we may need a more general graph-copying
-- routine. For now, do a sequential search to find desired node.
if Nkind (Old_Node) = N_Handled_Sequence_Of_Statements
and then Present (First_Real_Statement (Old_Node))
then
declare
Old_F : constant Node_Id := First_Real_Statement (Old_Node);
N1, N2 : Node_Id;
begin
N1 := First (Statements (Old_Node));
N2 := First (Statements (New_Node));
while N1 /= Old_F loop
Next (N1);
Next (N2);
end loop;
Set_First_Real_Statement (New_Node, N2);
end;
end if;
end if;
-- All done, return copied node
return New_Node;
end Copy_Node_With_Replacement;
-----------------
-- Visit_Elist --
-----------------
procedure Visit_Elist (E : Elist_Id) is
Elmt : Elmt_Id;
begin
if Present (E) then
Elmt := First_Elmt (E);
while Elmt /= No_Elmt loop
Visit_Node (Node (Elmt));
Next_Elmt (Elmt);
end loop;
end if;
end Visit_Elist;
-----------------
-- Visit_Field --
-----------------
procedure Visit_Field (F : Union_Id; N : Node_Id) is
begin
if F = Union_Id (Empty) then
return;
elsif F in Node_Range then
-- Copy node if it is syntactic, i.e. its parent pointer is
-- set to point to the field that referenced it (certain
-- Itypes will also meet this criterion, which is fine, since
-- these are clearly Itypes that do need to be copied, since
-- we are copying their parent.)
if Parent (Node_Id (F)) = N then
Visit_Node (Node_Id (F));
return;
-- Another case, if we are pointing to an Itype, then we want
-- to copy it if its associated node is somewhere in the tree
-- being copied.
-- Note: the exclusion of self-referential copies is just an
-- optimization, since the search of the already copied list
-- would catch it, but it is a common case (Etype pointing
-- to itself for an Itype that is a base type).
elsif Has_Extension (Node_Id (F))
and then Is_Itype (Entity_Id (F))
and then Node_Id (F) /= N
then
declare
P : Node_Id;
begin
P := Associated_Node_For_Itype (Node_Id (F));
while Present (P) loop
if P = Source then
Visit_Node (Node_Id (F));
return;
else
P := Parent (P);
end if;
end loop;
-- An Itype whose parent is not being copied definitely
-- should NOT be copied, since it does not belong in any
-- sense to the copied subtree.
return;
end;
end if;
elsif F in List_Range
and then Parent (List_Id (F)) = N
then
Visit_List (List_Id (F));
return;
end if;
end Visit_Field;
-----------------
-- Visit_Itype --
-----------------
-- Note: we are relying on far too much semantic knowledge in this
-- routine, it really should just do a blind replacement of all
-- fields, or at least a more blind replacement. For example, we
-- do not deal with corresponding record types, and that works
-- because we have no Itypes of task types, but nowhere is there
-- a guarantee that this will always be the case. ???
procedure Visit_Itype (Old_Itype : Entity_Id) is
New_Itype : Entity_Id;
E : Elmt_Id;
Ent : Entity_Id;
begin
-- Itypes that describe the designated type of access to subprograms
-- have the structure of subprogram declarations, with signatures,
-- etc. Either we duplicate the signatures completely, or choose to
-- share such itypes, which is fine because their elaboration will
-- have no side effects. In any case, this is additional semantic
-- information that seems awkward to have in atree.
if Ekind (Old_Itype) = E_Subprogram_Type then
return;
end if;
New_Itype := New_Copy (Old_Itype);
-- The new Itype has all the attributes of the old one, and
-- we just copy the contents of the entity. However, the back-end
-- needs different names for debugging purposes, so we create a
-- new internal name for it in all cases.
-- Set_Chars (New_Itype, New_Internal_Name ('T'));
-- If our associated node is an entity that has already been copied,
-- then set the associated node of the copy to point to the right
-- copy. If we have copied an Itype that is itself the associated
-- node of some previously copied Itype, then we set the right
-- pointer in the other direction.
if Present (Actual_Map) then
-- Case of hash tables used
if NCT_Hash_Tables_Used then
Ent := NCT_Assoc.Get (Associated_Node_For_Itype (Old_Itype));
if Present (Ent) then
Set_Associated_Node_For_Itype (New_Itype, Ent);
end if;
Ent := NCT_Itype_Assoc.Get (Old_Itype);
if Present (Ent) then
Set_Associated_Node_For_Itype (Ent, New_Itype);
-- If the hash table has no association for this Itype and
-- its associated node, enter one now.
else
NCT_Itype_Assoc.Set
(Associated_Node_For_Itype (Old_Itype), New_Itype);
end if;
-- Case of hash tables not used
else
E := First_Elmt (Actual_Map);
while Present (E) loop
if Associated_Node_For_Itype (Old_Itype) = Node (E) then
Set_Associated_Node_For_Itype
(New_Itype, Node (Next_Elmt (E)));
end if;
if Is_Type (Node (E))
and then
Old_Itype = Associated_Node_For_Itype (Node (E))
then
Set_Associated_Node_For_Itype
(Node (Next_Elmt (E)), New_Itype);
end if;
E := Next_Elmt (Next_Elmt (E));
end loop;
end if;
end if;
if Present (Freeze_Node (New_Itype)) then
Set_Is_Frozen (New_Itype, False);
Set_Freeze_Node (New_Itype, Empty);
end if;
-- Add new association to map
if No (Actual_Map) then
Actual_Map := New_Elmt_List;
end if;
Append_Elmt (Old_Itype, Actual_Map);
Append_Elmt (New_Itype, Actual_Map);
if NCT_Hash_Tables_Used then
NCT_Assoc.Set (Old_Itype, New_Itype);
else
NCT_Table_Entries := NCT_Table_Entries + 1;
if NCT_Table_Entries > NCT_Hash_Threshhold then
Build_NCT_Hash_Tables;
end if;
end if;
-- If a record subtype is simply copied, the entity list will be
-- shared. Thus cloned_Subtype must be set to indicate the sharing.
if Ekind (Old_Itype) = E_Record_Subtype
or else Ekind (Old_Itype) = E_Class_Wide_Subtype
then
Set_Cloned_Subtype (New_Itype, Old_Itype);
end if;
-- Visit descendents that eventually get copied
Visit_Field (Union_Id (Etype (Old_Itype)), Old_Itype);
if Is_Discrete_Type (Old_Itype) then
Visit_Field (Union_Id (Scalar_Range (Old_Itype)), Old_Itype);
elsif Has_Discriminants (Base_Type (Old_Itype)) then
-- ??? This should involve call to Visit_Field
Visit_Elist (Discriminant_Constraint (Old_Itype));
elsif Is_Array_Type (Old_Itype) then
if Present (First_Index (Old_Itype)) then
Visit_Field (Union_Id (List_Containing
(First_Index (Old_Itype))),
Old_Itype);
end if;
if Is_Packed (Old_Itype) then
Visit_Field (Union_Id (Packed_Array_Type (Old_Itype)),
Old_Itype);
end if;
end if;
Get_Name_String (Chars (Old_Itype));
Add_Char_To_Name_Buffer ('c');
Add_Nat_To_Name_Buffer (Int (Associated_Node_For_Itype (New_Itype)));
Set_Chars (New_Itype, Name_Enter);
end Visit_Itype;
----------------
-- Visit_List --
----------------
procedure Visit_List (L : List_Id) is
N : Node_Id;
begin
if L /= No_List then
N := First (L);
while Present (N) loop
Visit_Node (N);
Next (N);
end loop;
end if;
end Visit_List;
----------------
-- Visit_Node --
----------------
procedure Visit_Node (N : Node_Or_Entity_Id) is
-- Start of processing for Visit_Node
begin
-- Handle case of an Itype, which must be copied
if Has_Extension (N)
and then Is_Itype (N)
then
-- Nothing to do if already in the list. This can happen with an
-- Itype entity that appears more than once in the tree.
-- Note that we do not want to visit descendents in this case.
-- Test for already in list when hash table is used
if NCT_Hash_Tables_Used then
if Present (NCT_Assoc.Get (Entity_Id (N))) then
return;
end if;
-- Test for already in list when hash table not used
else
declare
E : Elmt_Id;
begin
if Present (Actual_Map) then
E := First_Elmt (Actual_Map);
while Present (E) loop
if Node (E) = N then
return;
else
E := Next_Elmt (Next_Elmt (E));
end if;
end loop;
end if;
end;
end if;
Visit_Itype (N);
end if;
-- Visit descendents
Visit_Field (Field1 (N), N);
Visit_Field (Field2 (N), N);
Visit_Field (Field3 (N), N);
Visit_Field (Field4 (N), N);
Visit_Field (Field5 (N), N);
end Visit_Node;
-- Start of processing for New_Copy_Tree
begin
Actual_Map := Map;
-- See if we should use hash table
if No (Actual_Map) then
NCT_Hash_Tables_Used := False;
else
declare
Elmt : Elmt_Id;
begin
NCT_Table_Entries := 0;
Elmt := First_Elmt (Actual_Map);
while Present (Elmt) loop
NCT_Table_Entries := NCT_Table_Entries + 1;
Next_Elmt (Elmt);
Next_Elmt (Elmt);
end loop;
if NCT_Table_Entries > NCT_Hash_Threshhold then
Build_NCT_Hash_Tables;
else
NCT_Hash_Tables_Used := False;
end if;
end;
end if;
-- Hash table set up if required, now start phase one by visiting
-- top node (we will recursively visit the descendents).
Visit_Node (Source);
-- Now the second phase of the copy can start. First we process
-- all the mapped entities, copying their descendents.
if Present (Actual_Map) then
declare
Elmt : Elmt_Id;
New_Itype : Entity_Id;
begin
Elmt := First_Elmt (Actual_Map);
while Present (Elmt) loop
Next_Elmt (Elmt);
New_Itype := Node (Elmt);
Copy_Itype_With_Replacement (New_Itype);
Next_Elmt (Elmt);
end loop;
end;
end if;
-- Now we can copy the actual tree
return Copy_Node_With_Replacement (Source);
end New_Copy_Tree1;
----------------
-- New_Entity --
----------------
......
gcc/ada/atree.ads
......@@ -430,46 +430,6 @@ package Atree is
-- Source to be Empty, in which case Relocate_Node simply returns
-- Empty as the result.
function New_Copy_Tree1
(Source : Node_Id;
Map : Elist_Id := No_Elist;
New_Sloc : Source_Ptr := No_Location;
New_Scope : Entity_Id := Empty) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
-- syntactic subtree, including recursively any descendents whose parent
-- field references a copied node (descendents not linked to a copied node
-- by the parent field are not copied, instead the copied tree references
-- the same descendent as the original in this case, which is appropriate
-- for non-syntactic fields such as Etype). The parent pointers in the
-- copy are properly set. Copy_Tree (Empty/Error) returns Empty/Error.
-- The one exception to the rule of not copying semantic fields is that
-- any implicit types attached to the subtree are duplicated, so that
-- the copy contains a distinct set of implicit type entities. The Map
-- argument, if set to a non-empty Elist, specifies a set of mappings
-- to be applied to entities in the tree. The map has the form:
--
-- old entity 1
-- new entity to replace references to entity 1
-- old entity 2
-- new entity to replace references to entity 2
-- ...
--
-- The call destroys the contents of Map in this case
--
-- The parameter New_Sloc, if set to a value other than No_Location, is
-- used as the Sloc value for all nodes in the new copy. If New_Sloc is
-- set to its default value No_Location, then the Sloc values of the
-- nodes in the copy are simply copied from the corresponding original.
--
-- The Comes_From_Source indication is unchanged if New_Sloc is set to
-- the default No_Location value, but is reset if New_Sloc is given, since
-- in this case the result clearly is neither a source node or an exact
-- copy of a source node.
--
-- The parameter New_Scope, if set to a value other than Empty, is the
-- value to use as the Scope for any Itypes that are copied. The most
-- typical value for this parameter, if given, is Current_Scope.
function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Separate_Tree copies
-- the entire syntactic subtree, including recursively any descendants
......
gcc/ada/exp_ch4.adb
......@@ -2822,7 +2822,7 @@ package body Exp_Ch4 is
-- There are nine or fewer retained (non-null) operands
-- The optimization level is -O0 or -Os
-- The optimization level is -O0
-- The corresponding System.Concat_n.Str_Concat_n routine is
-- available in the run time.
......@@ -2835,9 +2835,7 @@ package body Exp_Ch4 is
if Atyp = Standard_String
and then NN in 2 .. 9
and then (Opt.Optimization_Level = 0
or else Opt.Optimize_Size /= 0
or else Debug_Flag_Dot_CC)
and then (Opt.Optimization_Level = 0 or else Debug_Flag_Dot_CC)
and then not Debug_Flag_Dot_C
then
declare
......
gcc/ada/initialize.c
......@@ -81,6 +81,22 @@ __gnat_initialize (void *eh)
given that we have set Max_Digits etc with this in mind */
__gnat_init_float ();
#ifdef GNAT_UNICODE_SUPPORT
/* Set current code page for filenames handling. */
{
char *codepage = getenv ("GNAT_CODE_PAGE");
/* Default code page is UTF-8. */
CurrentCodePage = CP_UTF8;
if (codepage != NULL)
if (strcmp (codepage, "CP_ACP") == 0)
CurrentCodePage = CP_ACP;
else if (strcmp (codepage, "CP_UTF8") == 0)
CurrentCodePage = CP_UTF8;
}
#endif
/* Adjust gnat_argv to support Unicode characters. */
{
char arg_utf8[MAX_PATH];
......@@ -97,7 +113,7 @@ __gnat_initialize (void *eh)
for (k=0; k<wargc; k++)
{
WS2SU (arg_utf8, wargv[k], MAX_PATH);
WS2SC (arg_utf8, wargv[k], MAX_PATH);
gnat_argv[k] = (char *) xmalloc (strlen (arg_utf8) + 1);
strcpy (gnat_argv[k], arg_utf8);
}
......
gcc/ada/mingw32.h
......@@ -62,6 +62,7 @@
#endif
#include <tchar.h>
#include <windows.h>
/* After including this file it is possible to use the character t as prefix
to routines. If GNAT_UNICODE_SUPPORT is defined then the unicode enabled
......@@ -71,10 +72,22 @@
the proper translations using the UTF-8 encoding. */
#ifdef GNAT_UNICODE_SUPPORT
extern UINT CurrentCodePage;
/* Macros to convert to/from the code page speficied in CurrentCodePage. */
#define S2WSC(wstr,str,len) \
MultiByteToWideChar (CurrentCodePage,0,str,-1,wstr,len)
#define WS2SC(str,wstr,len) \
WideCharToMultiByte (CurrentCodePage,0,wstr,-1,str,len,NULL,NULL)
/* Macros to convert to/from UTF-8 code page. */
#define S2WSU(wstr,str,len) \
MultiByteToWideChar (CP_UTF8,0,str,-1,wstr,len)
#define WS2SU(str,wstr,len) \
WideCharToMultiByte (CP_UTF8,0,wstr,-1,str,len,NULL,NULL)
/* Macros to convert to/from Windows default code page. */
#define S2WS(wstr,str,len) \
MultiByteToWideChar (CP_ACP,0,str,-1,wstr,len)
#define WS2S(str,wstr,len) \
......
gcc/ada/mkdir.c
......@@ -65,7 +65,7 @@ __gnat_mkdir (char *dir_name)
#elif defined (__MINGW32__)
TCHAR wname [GNAT_MAX_PATH_LEN + 2];
S2WSU (wname, dir_name, GNAT_MAX_PATH_LEN + 2);
S2WSC (wname, dir_name, GNAT_MAX_PATH_LEN + 2);
return _tmkdir (wname);
#else
return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO);
......
gcc/ada/s-crtl.ads
......@@ -55,8 +55,8 @@ package System.CRTL is
type size_t is mod 2 ** Standard'Address_Size;
type Filename_Encoding is (UTF8, ASCII_8bits);
for Filename_Encoding use (UTF8 => 0, ASCII_8bits => 1);
type Filename_Encoding is (UTF8, ASCII_8bits, Unspecified);
for Filename_Encoding use (UTF8 => 0, ASCII_8bits => 1, Unspecified => 2);
pragma Convention (C, Filename_Encoding);
-- Describes the filename's encoding
......@@ -90,7 +90,7 @@ package System.CRTL is
function fopen
(filename : chars;
mode : chars;
encoding : Filename_Encoding := UTF8) return FILEs;
encoding : Filename_Encoding := Unspecified) return FILEs;
pragma Import (C, fopen, "__gnat_fopen");
function fputc (C : int; stream : FILEs) return int;
......@@ -106,7 +106,7 @@ package System.CRTL is
(filename : chars;
mode : chars;
stream : FILEs;
encoding : Filename_Encoding := UTF8) return FILEs;
encoding : Filename_Encoding := Unspecified) return FILEs;
pragma Import (C, freopen, "__gnat_freopen");
function fseek
......
gcc/ada/s-fileio.adb
......@@ -809,7 +809,7 @@ package body System.File_IO is
Form_Parameter (Formstr, "encoding", V1, V2);
if V1 = 0 then
Encoding := System.CRTL.UTF8;
Encoding := System.CRTL.Unspecified;
elsif Formstr (V1 .. V2) = "utf8" then
Encoding := System.CRTL.UTF8;
......
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