Skip to content

R
riscv-gcc-1
Commit 209db2bf by Arnaud Charlet
Options

[multiple changes] 

2003-12-15  Robert Dewar  <dewar@gnat.com>

	* exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default
	sec stack size.

2003-12-15  Vincent Celier  <celier@gnat.com>

	* gnatchop.adb: (Error_Msg): Do not exit on error for a warning
	(Gnatchop): Do not set failure status when reporting the number of
	warnings.

2003-12-15  Doug Rupp  <rupp@gnat.com>

	* s-ctrl.ads: New file.

	* Makefile.rtl (GNAT_RTL_NONTASKING_OBJS): Add s-crtl$(objext).

	* Make-lang.in: (GNAT_ADA_OBJS): Add ada/s-crtl.o.
	(GNATBIND_OBJS): Add ada/s-crtl.o.

	* Makefile.in [VMS]: Clean up ifeq rules.

	* gnatlink.adb, 6vcstrea.adb, a-direio.adb, a-sequio.adb,
	a-ststio.adb, a-textio.adb, g-os_lib.adb, a-witeio.adb,
	g-os_lib.ads, i-cstrea.adb, i-cstrea.ads, s-direio.adb,
	s-fileio.adb, s-memcop.ads, s-memory.adb, s-stache.adb,
	s-tasdeb.adb: Update copyright.
	Import System.CRTL.
	Make minor modifications to use System.CRTL declared functions instead
	of importing locally.

2003-12-15  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated

From-SVN: r74627
parent c1d5acdb
Showing with 420 additions and 236 deletions
gcc/ada/6vcstrea.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2003 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- --
......@@ -36,6 +36,8 @@
with Unchecked_Conversion;
package body Interfaces.C_Streams is
use type System.CRTL.size_t;
------------
-- fread --
------------
......@@ -154,14 +156,6 @@ package body Interfaces.C_Streams is
size : size_t)
return int
is
function C_setvbuf
(stream : FILEs;
buffer : chars;
mode : int;
size : size_t)
return int;
pragma Import (C, C_setvbuf, "setvbuf");
use type System.Address;
begin
......@@ -173,9 +167,11 @@ package body Interfaces.C_Streams is
if mode = IONBF
and then (stream = stdout or else stream = stderr)
then
return C_setvbuf (stream, buffer, IOLBF, size);
return System.CRTL.setvbuf
(stream, buffer, IOLBF, System.CRTL.size_t (size));
else
return C_setvbuf (stream, buffer, mode, size);
return System.CRTL.setvbuf
(stream, buffer, mode, System.CRTL.size_t (size));
end if;
end setvbuf;
......
gcc/ada/ChangeLog
2003-12-15 Robert Dewar <dewar@gnat.com>
* exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default
sec stack size.
2003-12-15 Vincent Celier <celier@gnat.com>
* gnatchop.adb: (Error_Msg): Do not exit on error for a warning
(Gnatchop): Do not set failure status when reporting the number of
warnings.
2003-12-15 Doug Rupp <rupp@gnat.com>
* s-ctrl.ads: New file.
* Makefile.rtl (GNAT_RTL_NONTASKING_OBJS): Add s-crtl$(objext).
* Make-lang.in: (GNAT_ADA_OBJS): Add ada/s-crtl.o.
(GNATBIND_OBJS): Add ada/s-crtl.o.
* Makefile.in [VMS]: Clean up ifeq rules.
* gnatlink.adb, 6vcstrea.adb, a-direio.adb, a-sequio.adb,
a-ststio.adb, a-textio.adb, g-os_lib.adb, a-witeio.adb,
g-os_lib.ads, i-cstrea.adb, i-cstrea.ads, s-direio.adb,
s-fileio.adb, s-memcop.ads, s-memory.adb, s-stache.adb,
s-tasdeb.adb: Update copyright.
Import System.CRTL.
Make minor modifications to use System.CRTL declared functions instead
of importing locally.
2003-12-15 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
2003-12-11 Ed Falis <falis@gnat.com>
* 5zinit.adb: Clean up.
......
gcc/ada/Make-lang.in
......@@ -153,7 +153,7 @@ GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
ada/stylesw.o ada/validsw.o ada/system.o ada/table.o ada/targparm.o \
ada/tbuild.o ada/tree_gen.o ada/tree_io.o ada/treepr.o ada/treeprs.o \
ada/ttypef.o ada/ttypes.o ada/types.o ada/uintp.o ada/uname.o ada/urealp.o \
ada/usage.o ada/widechar.o
ada/usage.o ada/widechar.o ada/s-crtl.o
# Object files for gnat executables
GNAT1_ADA_OBJS = $(GNAT_ADA_OBJS) ada/back_end.o ada/gnat1drv.o
......@@ -212,6 +212,7 @@ GNATBIND_OBJS = \
ada/s-carun8.o \
ada/s-casuti.o \
ada/s-crc32.o \
ada/s-crtl.o \
ada/s-except.o \
ada/s-exctab.o \
ada/s-htable.o \
......@@ -2254,10 +2255,10 @@ ada/g-htable.o : ada/gnat.ads ada/g-htable.ads ada/g-htable.adb \
ada/g-os_lib.o : ada/ada.ads ada/a-except.ads ada/gnat.ads \
ada/g-os_lib.ads ada/g-os_lib.adb ada/g-string.ads ada/system.ads \
ada/s-casuti.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads \
ada/unchdeal.ads
ada/s-casuti.ads ada/s-crtl.ads ada/s-exctab.ads ada/s-exctab.adb \
ada/s-htable.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-traent.ads ada/unchconv.ads ada/unchdeal.ads
ada/g-speche.o : ada/gnat.ads ada/g-speche.ads ada/g-speche.adb \
ada/system.ads
......@@ -2711,6 +2712,8 @@ ada/s-casuti.o : ada/system.ads ada/s-casuti.ads ada/s-casuti.adb
ada/s-crc32.o : ada/interfac.ads ada/system.ads ada/s-crc32.ads \
ada/s-crc32.adb
ada/s-crtl.o : ada/system.ads ada/s-crtl.ads ada/s-parame.ads
ada/s-except.o : ada/ada.ads ada/a-except.ads ada/system.ads \
ada/s-except.ads ada/s-stalib.ads ada/s-traent.ads ada/unchconv.ads
......@@ -2730,9 +2733,9 @@ ada/s-mastop.o : ada/ada.ads ada/a-except.ads ada/system.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads
ada/s-memory.o : ada/ada.ads ada/a-except.ads ada/system.ads \
ada/s-memory.ads ada/s-memory.adb ada/s-parame.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-traent.ads ada/unchconv.ads
ada/s-crtl.ads ada/s-memory.ads ada/s-memory.adb ada/s-parame.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads
ada/s-parame.o : ada/system.ads ada/s-parame.ads ada/s-parame.adb
......@@ -2761,9 +2764,9 @@ ada/s-sopco5.o : ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \
ada/s-sopco5.ads ada/s-sopco5.adb ada/unchconv.ads
ada/s-stache.o : ada/ada.ads ada/a-except.ads ada/system.ads \
ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stache.adb \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads \
ada/unchconv.ads
ada/s-crtl.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stache.adb ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-traent.ads ada/unchconv.ads
ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.ads \
ada/s-memory.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
......
gcc/ada/Makefile.in
......@@ -1123,7 +1123,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(host))),)
ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
soext = .exe
......@@ -1134,17 +1134,32 @@ soext = .exe
endif
ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),)
ifeq ($(strip $(filter-out alpha64% dec vms% openvms% alphavms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX =
ifeq ($(strip $(filter-out ia64% hp vms% openvms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5xosinte.adb \
s-osinte.ads<5xosinte.ads \
s-parame.ads<5vparame.ads
else
ifeq ($(strip $(filter-out alpha64% dec hp vms% openvms% alphavms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-parame.ads<5vparame.ads
else
ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-parame.ads<5xparame.ads
else
LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-parame.ads<5vparame.ads
endif
endif
endif
LIBGNAT_TARGET_PAIRS = \
a-caldel.adb<4vcaldel.adb \
......@@ -1152,6 +1167,7 @@ endif
a-calend.ads<4vcalend.ads \
a-excpol.adb<4wexcpol.adb \
a-intnam.ads<4vintnam.ads \
a-numaux.ads<4vnumaux.ads \
g-expect.adb<3vexpect.adb \
g-soccon.ads<3vsoccon.ads \
g-socthi.ads<3vsocthi.ads \
......@@ -1161,12 +1177,11 @@ endif
i-cpp.adb<6vcpp.adb \
interfac.ads<6vinterf.ads \
s-asthan.adb<5vasthan.adb \
s-crtl.ads<5vcrtl.ads \
s-inmaop.adb<5vinmaop.adb \
s-interr.adb<5vinterr.adb \
s-intman.adb<5vintman.adb \
s-intman.ads<5vintman.ads \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-osprim.adb<5vosprim.adb \
s-osprim.ads<5vosprim.ads \
s-taprop.adb<5vtaprop.adb \
......
gcc/ada/Makefile.rtl
# Makefile.rtl for GNU Ada Compiler (GNAT).
# Copyright (C) 2002 Free Software Foundation, Inc.
# Copyright (C) 2003 Free Software Foundation, Inc.
#This file is part of GCC.
......@@ -283,6 +283,7 @@ GNATRTL_NONTASKING_OBJS= \
s-caun32$(objext) \
s-caun64$(objext) \
s-chepoo$(objext) \
s-crtl$(objext) \
s-crc32$(objext) \
s-direio$(objext) \
s-errrep$(objext) \
......
gcc/ada/a-direio.adb
......@@ -38,6 +38,7 @@
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.CRTL;
with System.File_Control_Block;
with System.File_IO;
with System.Direct_IO;
......@@ -65,6 +66,8 @@ package body Ada.Direct_IO is
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type System.CRTL.size_t;
-----------
-- Close --
-----------
......
gcc/ada/a-sequio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003, 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- --
......@@ -38,6 +38,7 @@
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.CRTL;
with System.File_Control_Block;
with System.File_IO;
with System.Storage_Elements;
......@@ -58,6 +59,8 @@ package body Ada.Sequential_IO is
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_SIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type System.CRTL.size_t;
-----------
-- Close --
-----------
......
gcc/ada/a-ststio.adb
......@@ -35,6 +35,7 @@ with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.File_IO;
with System.Soft_Links;
with System.CRTL;
with Unchecked_Conversion;
with Unchecked_Deallocation;
......@@ -382,8 +383,11 @@ package body Ada.Streams.Stream_IO is
------------------
procedure Set_Position (File : in File_Type) is
use type System.CRTL.long;
begin
if fseek (File.Stream, long (File.Index) - 1, SEEK_SET) /= 0 then
if fseek (File.Stream,
System.CRTL.long (File.Index) - 1, SEEK_SET) /= 0
then
raise Use_Error;
end if;
end Set_Position;
......
gcc/ada/a-textio.adb
......@@ -35,6 +35,7 @@ with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.File_IO;
with System.CRTL;
with Unchecked_Conversion;
with Unchecked_Deallocation;
......@@ -51,6 +52,8 @@ package body Ada.Text_IO is
function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type FCB.File_Mode;
use type System.CRTL.size_t;
-------------------
-- AFCB_Allocate --
-------------------
......
gcc/ada/a-witeio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003 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- --
......@@ -36,6 +36,7 @@ with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.CRTL;
with System.File_IO;
with System.WCh_Cnv; use System.WCh_Cnv;
with System.WCh_Con; use System.WCh_Con;
......@@ -55,6 +56,8 @@ package body Ada.Wide_Text_IO is
function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type FCB.File_Mode;
use type System.CRTL.size_t;
WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding");
......
gcc/ada/exp_ch6.adb
......@@ -2992,7 +2992,7 @@ package body Exp_Ch6 is
Make_Integer_Literal (Loc,
Intval =>
Expr_Value
(Expression (RTE (RE_Default_Secondary_Stack_Size))));
(Constant_Value (RTE (RE_Default_Secondary_Stack_Size))));
end if;
Sec_Stack_Len := Convert_To (RTE (RE_Storage_Offset), Sec_Stack_Len);
......
gcc/ada/g-os_lib.adb
......@@ -32,6 +32,7 @@
------------------------------------------------------------------------------
with System.Case_Util;
with System.CRTL;
with System.Soft_Links;
with Unchecked_Conversion;
with System; use System;
......@@ -82,8 +83,7 @@ package body GNAT.OS_Lib is
function To_Path_String_Access
(Path_Addr : Address;
Path_Len : Integer)
return String_Access;
Path_Len : Integer) return String_Access;
-- Converts a C String to an Ada String. We could do this making use of
-- Interfaces.C.Strings but we prefer not to import that entire package
......@@ -143,8 +143,7 @@ package body GNAT.OS_Lib is
-----------------------------
function Argument_String_To_List
(Arg_String : String)
return Argument_List_Access
(Arg_String : String) return Argument_List_Access
is
Max_Args : constant Integer := Arg_String'Length;
New_Argv : Argument_List (1 .. Max_Args);
......@@ -397,8 +396,7 @@ package body GNAT.OS_Lib is
function Copy_Attributes
(From, To : System.Address;
Mode : Integer)
return Integer;
Mode : Integer) return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes
......@@ -558,8 +556,7 @@ package body GNAT.OS_Lib is
function Copy_Attributes
(From, To : System.Address;
Mode : Integer)
return Integer;
Mode : Integer) return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes
......@@ -611,13 +608,11 @@ package body GNAT.OS_Lib is
function Create_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
function C_Create_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_open_create");
begin
......@@ -626,8 +621,7 @@ package body GNAT.OS_Lib is
function Create_File
(Name : String;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
......@@ -643,13 +637,11 @@ package body GNAT.OS_Lib is
function Create_New_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
function C_Create_New_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Create_New_File, "__gnat_open_new");
begin
......@@ -658,8 +650,7 @@ package body GNAT.OS_Lib is
function Create_New_File
(Name : String;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
......@@ -679,8 +670,7 @@ package body GNAT.OS_Lib is
is
function Open_New_Temp
(Name : System.Address;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
pragma Import (C, Open_New_Temp, "__gnat_open_new_temp");
begin
......@@ -1225,8 +1215,7 @@ package body GNAT.OS_Lib is
-------------------------
function Locate_Exec_On_Path
(Exec_Name : String)
return String_Access
(Exec_Name : String) return String_Access
is
function Locate_Exec_On_Path (C_Exec_Name : Address) return Address;
pragma Import (C, Locate_Exec_On_Path, "__gnat_locate_exec_on_path");
......@@ -1262,8 +1251,7 @@ package body GNAT.OS_Lib is
function Locate_Regular_File
(File_Name : C_File_Name;
Path : C_File_Name)
return String_Access
Path : C_File_Name) return String_Access
is
function Locate_Regular_File
(C_File_Name, Path_Val : Address) return Address;
......@@ -1291,8 +1279,7 @@ package body GNAT.OS_Lib is
function Locate_Regular_File
(File_Name : String;
Path : String)
return String_Access
Path : String) return String_Access
is
C_File_Name : String (1 .. File_Name'Length + 1);
C_Path : String (1 .. Path'Length + 1);
......@@ -1313,8 +1300,7 @@ package body GNAT.OS_Lib is
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List)
return Process_Id
Args : Argument_List) return Process_Id
is
Junk : Integer;
Pid : Process_Id;
......@@ -1428,8 +1414,7 @@ package body GNAT.OS_Lib is
(Name : String;
Directory : String := "";
Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True)
return String
Case_Sensitive : Boolean := True) return String
is
Max_Path : Integer;
pragma Import (C, Max_Path, "__gnat_max_path_len");
......@@ -1465,13 +1450,11 @@ package body GNAT.OS_Lib is
function Readlink
(Path : System.Address;
Buf : System.Address;
Bufsiz : Integer)
return Integer;
Bufsiz : Integer) return Integer;
pragma Import (C, Readlink, "__gnat_readlink");
function To_Canonical_File_Spec
(Host_File : System.Address)
return System.Address;
(Host_File : System.Address) return System.Address;
pragma Import
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
......@@ -1909,13 +1892,11 @@ package body GNAT.OS_Lib is
function Open_Read
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
function C_Open_Read
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Open_Read, "__gnat_open_read");
begin
......@@ -1924,8 +1905,7 @@ package body GNAT.OS_Lib is
function Open_Read
(Name : String;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
......@@ -1941,13 +1921,11 @@ package body GNAT.OS_Lib is
function Open_Read_Write
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
function C_Open_Read_Write
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
pragma Import (C, C_Open_Read_Write, "__gnat_open_rw");
begin
......@@ -1956,8 +1934,7 @@ package body GNAT.OS_Lib is
function Open_Read_Write
(Name : String;
Fmode : Mode)
return File_Descriptor
Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
......@@ -1967,6 +1944,20 @@ package body GNAT.OS_Lib is
return Open_Read_Write (C_Name (C_Name'First)'Address, Fmode);
end Open_Read_Write;
----------
-- Read --
----------
function Read
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer
is
begin
return Integer (System.CRTL.read
(System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N)));
end Read;
-----------------
-- Rename_File --
-----------------
......@@ -2031,8 +2022,7 @@ package body GNAT.OS_Lib is
function Spawn
(Program_Name : String;
Args : Argument_List)
return Integer
Args : Argument_List) return Integer
is
Junk : Process_Id;
Result : Integer;
......@@ -2173,8 +2163,7 @@ package body GNAT.OS_Lib is
function To_Path_String_Access
(Path_Addr : Address;
Path_Len : Integer)
return String_Access
Path_Len : Integer) return String_Access
is
subtype Path_String is String (1 .. Path_Len);
type Path_String_Access is access Path_String;
......@@ -2213,4 +2202,18 @@ package body GNAT.OS_Lib is
Success := (Status = 0);
end Wait_Process;
-----------
-- Write --
-----------
function Write
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer
is
begin
return Integer (System.CRTL.write
(System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N)));
end Write;
end GNAT.OS_Lib;
gcc/ada/g-os_lib.ads
......@@ -175,31 +175,27 @@ pragma Elaborate_Body (OS_Lib);
function Open_Read
(Name : String;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
-- Open file Name for reading, returning file descriptor File descriptor
-- returned is Invalid_FD if file cannot be opened.
function Open_Read_Write
(Name : String;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
-- Open file Name for both reading and writing, returning file
-- descriptor. File descriptor returned is Invalid_FD if file cannot be
-- opened.
function Create_File
(Name : String;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
-- Creates new file with given name for writing, returning file descriptor
-- for subsequent use in Write calls. File descriptor returned is
-- Invalid_FD if file cannot be successfully created
function Create_New_File
(Name : String;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
-- Create new file with given name for writing, returning file descriptor
-- for subsequent use in Write calls. This differs from Create_File in
-- that it fails if the file already exists. File descriptor returned is
......@@ -334,18 +330,14 @@ pragma Elaborate_Body (OS_Lib);
function Read
(FD : File_Descriptor;
A : System.Address;
N : Integer)
return Integer;
pragma Import (C, Read, "read");
N : Integer) return Integer;
-- Read N bytes to address A from file referenced by FD. Returned value
-- is count of bytes actually read, which can be less than N at EOF.
function Write
(FD : File_Descriptor;
A : System.Address;
N : Integer)
return Integer;
pragma Import (C, Write, "write");
N : Integer) return Integer;
-- Write N bytes from address A to file referenced by FD. The returned
-- value is the number of bytes written, which can be less than N if
-- a disk full condition was detected.
......@@ -379,8 +371,7 @@ pragma Elaborate_Body (OS_Lib);
(Name : String;
Directory : String := "";
Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True)
return String;
Case_Sensitive : Boolean := True) return String;
-- Returns a file name as an absolute path name, resolving all relative
-- directories, and symbolic links. The parameter Directory is a fully
-- resolved path name for a directory, or the empty string (the default).
......@@ -458,8 +449,7 @@ pragma Elaborate_Body (OS_Lib);
-- span file systems and may refer to directories.
function Locate_Exec_On_Path
(Exec_Name : String)
return String_Access;
(Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the
-- directories listed in the environment Path. If the Exec_Name doesn't
-- have the executable suffix, it will be appended before the search.
......@@ -470,8 +460,7 @@ pragma Elaborate_Body (OS_Lib);
function Locate_Regular_File
(File_Name : String;
Path : String)
return String_Access;
Path : String) return String_Access;
-- Try to locate a regular file whose name is given by File_Name in the
-- directories listed in Path. If a file is found, its full pathname is
-- returned; otherwise, a null pointer is returned. If the File_Name given
......@@ -511,25 +500,23 @@ pragma Elaborate_Body (OS_Lib);
-- This subtype is used to document that a parameter is the address
-- of a null-terminated string containing the name of a file.
-- All the following functions need comments ???
function Open_Read
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
function Open_Read_Write
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
function Create_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
function Create_New_File
(Name : C_File_Name;
Fmode : Mode)
return File_Descriptor;
Fmode : Mode) return File_Descriptor;
procedure Delete_File (Name : C_File_Name; Success : out Boolean);
......
gcc/ada/gnatchop.adb
......@@ -342,10 +342,10 @@ procedure Gnatchop is
if not Warning then
Set_Exit_Status (Failure);
end if;
if Exit_On_Error then
raise Terminate_Program;
if Exit_On_Error then
raise Terminate_Program;
end if;
end if;
end Error_Msg;
......@@ -1738,7 +1738,7 @@ begin
declare
Warnings_Msg : String := Warning_Count'Img & " warning(s)";
begin
Error_Msg (Warnings_Msg (2 .. Warnings_Msg'Last));
Error_Msg (Warnings_Msg (2 .. Warnings_Msg'Last), Warning => True);
end;
end if;
......
gcc/ada/gnatlink.adb
......@@ -42,6 +42,7 @@ with Types;
with Ada.Command_Line; use Ada.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL;
procedure Gnatlink is
pragma Ident (Gnatvsn.Gnat_Static_Version_String);
......@@ -770,6 +771,7 @@ procedure Gnatlink is
------------------------
procedure Store_File_Context is
use type System.CRTL.long;
begin
RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst;
......
gcc/ada/i-cstrea.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2003 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- --
......@@ -39,6 +39,8 @@ with Unchecked_Conversion;
package body Interfaces.C_Streams is
use type System.CRTL.size_t;
------------
-- fread --
------------
......
gcc/ada/i-cstrea.ads
......@@ -34,38 +34,17 @@
-- This package is a thin binding to selected functions in the C
-- library that provide a complete interface for handling C streams.
with System.Parameters;
with System.CRTL;
package Interfaces.C_Streams is
pragma Preelaborate;
-- Note: the reason we do not use the types that are in Interfaces.C is
-- that we want to avoid dragging in the code in this unit if possible.
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
subtype FILEs is System.Address;
-- Corresponds to the C type FILE*
subtype chars is System.CRTL.chars;
subtype FILEs is System.CRTL.FILEs;
subtype int is System.CRTL.int;
subtype long is System.CRTL.long;
subtype size_t is System.CRTL.size_t;
subtype voids is System.Address;
-- Corresponds to the C type void*
subtype int is Integer;
-- Note: the above type is a subtype deliberately, and it is part of
-- this spec that the above correspondence is guaranteed. This means
-- that it is legitimate to, for example, use Integer instead of int.
-- We provide this synonym for clarity, but in some cases it may be
-- convenient to use the underlying types (for example to avoid an
-- unnecessary dependency of a spec on the spec of this unit).
type long is range -(2 ** (System.Parameters.long_bits - 1))
.. +(2 ** (System.Parameters.long_bits - 1)) - 1;
-- Note: the above type also used to be a subtype, but the correspondence
-- was unused so it was made into a parameterized type to avoid having
-- multiple versions of this spec for systems where long /= Long_Integer.
type size_t is mod 2 ** Standard'Address_Size;
NULL_Stream : constant FILEs;
-- Value returned (NULL in C) to indicate an fdopen/fopen/tmpfile error
......@@ -106,34 +85,39 @@ package Interfaces.C_Streams is
-- Library Reference" (Microsoft Press, 1990, ISBN 1-55615-225-6),
-- which includes useful information on system compatibility.
procedure clearerr (stream : FILEs);
procedure clearerr (stream : FILEs) renames System.CRTL.clearerr;
function fclose (stream : FILEs) return int;
function fclose (stream : FILEs) return int renames System.CRTL.fclose;
function fdopen (handle : int; mode : chars) return FILEs;
function fdopen (handle : int; mode : chars) return FILEs
renames System.CRTL.fdopen;
function feof (stream : FILEs) return int;
function ferror (stream : FILEs) return int;
function fflush (stream : FILEs) return int;
function fflush (stream : FILEs) return int renames System.CRTL.fflush;
function fgetc (stream : FILEs) return int;
function fgetc (stream : FILEs) return int renames System.CRTL.fgetc;
function fgets (strng : chars; n : int; stream : FILEs) return chars;
function fgets (strng : chars; n : int; stream : FILEs) return chars
renames System.CRTL.fgets;
function fileno (stream : FILEs) return int;
function fopen (filename : chars; Mode : chars) return FILEs;
function fopen (filename : chars; Mode : chars) return FILEs
renames System.CRTL.fopen;
-- Note: to maintain target independence, use text_translation_required,
-- a boolean variable defined in a-sysdep.c to deal with the target
-- dependent text translation requirement. If this variable is set,
-- then b/t should be appended to the standard mode argument to set
-- the text translation mode off or on as required.
function fputc (C : int; stream : FILEs) return int;
function fputc (C : int; stream : FILEs) return int
renames System.CRTL.fputc;
function fputs (Strng : chars; Stream : FILEs) return int;
function fputs (Strng : chars; Stream : FILEs) return int
renames System.CRTL.fputs;
function fread
(buffer : voids;
......@@ -159,15 +143,16 @@ package Interfaces.C_Streams is
(filename : chars;
mode : chars;
stream : FILEs)
return FILEs;
return FILEs renames System.CRTL.freopen;
function fseek
(stream : FILEs;
offset : long;
origin : int)
return int;
return int renames System.CRTL.fseek;
function ftell (stream : FILEs) return long;
function ftell (stream : FILEs) return long
renames System.CRTL.ftell;
function fwrite
(buffer : voids;
......@@ -176,12 +161,12 @@ package Interfaces.C_Streams is
stream : FILEs)
return size_t;
function isatty (handle : int) return int;
function isatty (handle : int) return int renames System.CRTL.isatty;
procedure mktemp (template : chars);
procedure mktemp (template : chars) renames System.CRTL.mktemp;
-- The return value (which is just a pointer to template) is discarded
procedure rewind (stream : FILEs);
procedure rewind (stream : FILEs) renames System.CRTL.rewind;
function setvbuf
(stream : FILEs;
......@@ -190,16 +175,18 @@ package Interfaces.C_Streams is
size : size_t)
return int;
procedure tmpnam (string : chars);
procedure tmpnam (string : chars) renames System.CRTL.tmpnam;
-- The parameter must be a pointer to a string buffer of at least L_tmpnam
-- bytes (the call with a null parameter is not supported). The returned
-- value, which is just a copy of the input argument, is discarded.
function tmpfile return FILEs;
function tmpfile return FILEs renames System.CRTL.tmpfile;
function ungetc (c : int; stream : FILEs) return int;
function ungetc (c : int; stream : FILEs) return int
renames System.CRTL.ungetc;
function unlink (filename : chars) return int;
function unlink (filename : chars) return int
renames System.CRTL.unlink;
---------------------
-- Extra functions --
......@@ -253,29 +240,6 @@ private
pragma Inline (fwrite);
pragma Inline (setvbuf);
-- The following routines are always functions in C, and thus can be
-- imported directly into Ada without any intermediate C needed
pragma Import (C, clearerr);
pragma Import (C, fclose);
pragma Import (C, fdopen);
pragma Import (C, fflush);
pragma Import (C, fgetc);
pragma Import (C, fgets);
pragma Import (C, fopen);
pragma Import (C, fputc);
pragma Import (C, fputs);
pragma Import (C, freopen);
pragma Import (C, fseek);
pragma Import (C, ftell);
pragma Import (C, isatty);
pragma Import (C, mktemp);
pragma Import (C, rewind);
pragma Import (C, tmpnam);
pragma Import (C, tmpfile);
pragma Import (C, ungetc);
pragma Import (C, unlink);
pragma Import (C, file_exists, "__gnat_file_exists");
pragma Import (C, is_regular_file, "__gnat_is_regular_file_fd");
......
gcc/ada/s-crtl.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . C R T L --
-- --
-- S p e c --
-- --
-- Copyright (C) 2003 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package provides the low level interface to the C Run Time Library
-- on non-VMS systems.
with System.Parameters;
package System.CRTL is
pragma Pure (CRTL);
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
subtype FILEs is System.Address;
-- Corresponds to the C type FILE*
subtype int is Integer;
type long is range -(2 ** (System.Parameters.long_bits - 1))
.. +(2 ** (System.Parameters.long_bits - 1)) - 1;
subtype off_t is Long_Integer;
type size_t is mod 2 ** Standard'Address_Size;
function atoi (A : System.Address) return Integer;
pragma Import (C, atoi, "atoi");
procedure clearerr (stream : FILEs);
pragma Import (C, clearerr, "clearerr");
function fclose (stream : FILEs) return int;
pragma Import (C, fclose, "fclose");
function fdopen (handle : int; mode : chars) return FILEs;
pragma Import (C, fdopen, "fdopen");
function fflush (stream : FILEs) return int;
pragma Import (C, fflush, "fflush");
function fgetc (stream : FILEs) return int;
pragma Import (C, fgetc, "fgetc");
function fgets (strng : chars; n : int; stream : FILEs) return chars;
pragma Import (C, fgets, "fgets");
function fopen (filename : chars; Mode : chars) return FILEs;
pragma Import (C, fopen, "fopen");
function fputc (C : int; stream : FILEs) return int;
pragma Import (C, fputc, "fputc");
function fputs (Strng : chars; Stream : FILEs) return int;
pragma Import (C, fputs, "fputs");
procedure free (Ptr : System.Address);
pragma Import (C, free, "free");
function freopen
(filename : chars;
mode : chars;
stream : FILEs)
return FILEs;
pragma Import (C, freopen, "freopen");
function fseek
(stream : FILEs;
offset : long;
origin : int)
return int;
pragma Import (C, fseek, "fseek");
function ftell (stream : FILEs) return long;
pragma Import (C, ftell, "ftell");
function getenv (S : String) return System.Address;
pragma Import (C, getenv, "getenv");
function isatty (handle : int) return int;
pragma Import (C, isatty, "isatty");
function lseek (fd : int; offset : off_t; direction : int) return off_t;
pragma Import (C, lseek, "lseek");
function malloc (Size : size_t) return System.Address;
pragma Import (C, malloc, "malloc");
procedure memcpy (S1 : System.Address; S2 : System.Address; N : size_t);
pragma Import (C, memcpy, "memcpy");
procedure memmove (S1 : System.Address; S2 : System.Address; N : size_t);
pragma Import (C, memmove, "memmove");
procedure mktemp (template : chars);
pragma Import (C, mktemp, "mktemp");
function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read");
function realloc
(Ptr : System.Address; Size : size_t) return System.Address;
pragma Import (C, realloc, "realloc");
procedure rewind (stream : FILEs);
pragma Import (C, rewind, "rewind");
function setvbuf
(stream : FILEs;
buffer : chars;
mode : int;
size : size_t)
return int;
pragma Import (C, setvbuf, "setvbuf");
procedure tmpnam (string : chars);
pragma Import (C, tmpnam, "tmpnam");
function tmpfile return FILEs;
pragma Import (C, tmpfile, "tmpfile");
function ungetc (c : int; stream : FILEs) return int;
pragma Import (C, ungetc, "ungetc");
function unlink (filename : chars) return int;
pragma Import (C, unlink, "unlink");
function write (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, write, "write");
end System.CRTL;
gcc/ada/s-direio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003 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- --
......@@ -34,6 +34,7 @@
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System;
with System.CRTL;
with System.File_IO;
with System.Soft_Links;
with Unchecked_Deallocation;
......@@ -46,6 +47,9 @@ package body System.Direct_IO is
subtype AP is FCB.AFCB_Ptr;
use type FCB.Shared_Status_Type;
use type System.CRTL.long;
use type System.CRTL.size_t;
-----------------------
-- Local Subprograms --
-----------------------
......
gcc/ada/s-fileio.adb
......@@ -34,6 +34,7 @@
with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL;
with System.Soft_Links;
with Unchecked_Deallocation;
......@@ -43,6 +44,8 @@ package body System.File_IO is
package SSL renames System.Soft_Links;
use type System.CRTL.size_t;
----------------------
-- Global Variables --
----------------------
......
gcc/ada/s-memcop.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2002 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,24 +35,27 @@
-- --
------------------------------------------------------------------------------
-- This package provides general block copy mechanisms analgous to those
-- This package provides general block copy mechanisms analogous to those
-- provided by the C routines memcpy and memmove allowing for copies with
-- and without possible overflow.
-- and without possible overlap of the operands.
-- The idea is to allow a configurable run-time to provide this capability
-- for use by the compiler without dragging in C-run time routines.
with System.CRTL;
-- The above with is contrary to the intent ???
package System.Memory_Copy is
pragma Preelaborate;
type size_t is mod 2 ** Standard'Address_Size;
-- Note: the reason we redefine this here instead of using the
-- definition in Interfaces.C is that we do not want to drag in
-- all of Interfaces.C just because System.Memory_Copy is used.
procedure memcpy (S1 : Address; S2 : Address; N : size_t);
procedure memcpy (S1 : Address; S2 : Address; N : System.CRTL.size_t)
renames System.CRTL.memcpy;
-- Copies N storage units from area starting at S2 to area starting
-- at S1 without any check for buffer overflow. The memory areas
-- must not overlap, or the result of this call is undefined.
procedure memmove (S1 : Address; S2 : Address; N : size_t);
procedure memmove (S1 : Address; S2 : Address; N : System.CRTL.size_t)
renames System.CRTL.memmove;
-- Copies N storage units from area starting at S2 to area starting
-- at S1 without any check for buffer overflow. The difference between
-- this memmove and memcpy is that with memmove, the storage areas may
......@@ -60,8 +63,6 @@ pragma Preelaborate;
-- is as if S2 is first moved to a temporary area, and then this area
-- is copied to S1 in a separate step).
private
-- In the standard library, these are just interfaced to the C routines.
-- But in the HI-E (high integrity version) they may be reprogrammed to
-- meet certification requirements (and marked High_Integrity).
......@@ -70,7 +71,4 @@ private
-- available, and the HI-E compiler will as a result generate implicit
-- loops (which will violate the restriction No_Implicit_Loops).
pragma Import (C, memcpy, "memcpy");
pragma Import (C, memmove, "memmove");
end System.Memory_Copy;
gcc/ada/s-memory.adb
......@@ -46,21 +46,22 @@
with Ada.Exceptions;
with System.Soft_Links;
with System.Parameters;
with System.CRTL;
package body System.Memory is
use Ada.Exceptions;
use System.Soft_Links;
function c_malloc (Size : size_t) return System.Address;
pragma Import (C, c_malloc, "malloc");
function c_malloc (Size : System.CRTL.size_t) return System.Address
renames System.CRTL.malloc;
procedure c_free (Ptr : System.Address);
pragma Import (C, c_free, "free");
procedure c_free (Ptr : System.Address)
renames System.CRTL.free;
function c_realloc
(Ptr : System.Address; Size : size_t) return System.Address;
pragma Import (C, c_realloc, "realloc");
(Ptr : System.Address; Size : System.CRTL.size_t) return System.Address
renames System.CRTL.realloc;
-----------
-- Alloc --
......@@ -85,10 +86,10 @@ package body System.Memory is
end if;
if Parameters.No_Abort then
Result := c_malloc (Actual_Size);
Result := c_malloc (System.CRTL.size_t (Actual_Size));
else
Abort_Defer.all;
Result := c_malloc (Actual_Size);
Result := c_malloc (System.CRTL.size_t (Actual_Size));
Abort_Undefer.all;
end if;
......@@ -132,10 +133,10 @@ package body System.Memory is
end if;
if Parameters.No_Abort then
Result := c_realloc (Ptr, Actual_Size);
Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
else
Abort_Defer.all;
Result := c_realloc (Ptr, Actual_Size);
Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
Abort_Undefer.all;
end if;
......
gcc/ada/s-stache.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -36,6 +36,7 @@ with Ada.Exceptions;
with System.Storage_Elements; use System.Storage_Elements;
with System.Parameters; use System.Parameters;
with System.Soft_Links;
with System.CRTL;
package body System.Stack_Checking is
......@@ -72,7 +73,6 @@ package body System.Stack_Checking is
procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
pragma Warnings (Off, Any_Stack);
begin
Cache := Null_Stack;
end Invalidate_Stack_Cache;
......@@ -82,8 +82,7 @@ package body System.Stack_Checking is
--------------------
function Set_Stack_Info
(Stack : access Stack_Access)
return Stack_Access
(Stack : access Stack_Access) return Stack_Access
is
type Frame_Mark is null record;
Frame_Location : Frame_Mark;
......@@ -93,12 +92,6 @@ package body System.Stack_Checking is
Limit_Chars : System.Address;
Limit : Integer;
function getenv (S : String) return System.Address;
pragma Import (C, getenv, External_Name => "getenv");
function atoi (A : System.Address) return Integer;
pragma Import (C, atoi);
begin
-- The order of steps 1 .. 3 is important, see specification.
......@@ -113,16 +106,16 @@ package body System.Stack_Checking is
-- the current frame address.
if My_Stack.Size = 0 then
My_Stack.Size := Storage_Offset (Default_Env_Stack_Size);
-- When the environment variable GNAT_STACK_LIMIT is set,
-- set Environment_Stack_Size to that number of kB.
Limit_Chars := getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
Limit_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
if Limit_Chars /= Null_Address then
Limit := atoi (Limit_Chars);
Limit := System.CRTL.atoi (Limit_Chars);
if Limit >= 0 then
My_Stack.Size := Storage_Offset (Limit) * Kilobyte;
end if;
......@@ -192,8 +185,7 @@ package body System.Stack_Checking is
-----------------
function Stack_Check
(Stack_Address : System.Address)
return Stack_Access
(Stack_Address : System.Address) return Stack_Access
is
type Frame_Marker is null record;
Marker : Frame_Marker;
......@@ -227,7 +219,6 @@ package body System.Stack_Checking is
-- it is essential to use our local copy of Stack!
begin
if (Stack_Grows_Down and then
(not (Frame_Address <= My_Stack.Base)))
or else
......
gcc/ada/s-tasdeb.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -39,14 +39,12 @@
-- Do not add any dependency to GNARL packages since this package is used
-- in both normal and restricted (ravenscar) environments.
with Interfaces.C;
with System.CRTL;
with System.Task_Primitives.Operations;
with Unchecked_Conversion;
package body System.Tasking.Debug is
use Interfaces.C;
package STPO renames System.Task_Primitives.Operations;
function To_Integer is new
......@@ -60,8 +58,7 @@ package body System.Tasking.Debug is
-- Local Subprograms --
-----------------------
procedure write (Fd : Integer; S : String; Count : size_t);
pragma Import (C, write);
procedure Write (Fd : Integer; S : String; Count : Integer);
procedure Put (S : String);
-- Display S on standard output.
......@@ -177,7 +174,7 @@ package body System.Tasking.Debug is
procedure Put (S : String) is
begin
write (2, S, S'Length);
Write (2, S, S'Length);
end Put;
--------------
......@@ -186,7 +183,7 @@ package body System.Tasking.Debug is
procedure Put_Line (S : String := "") is
begin
write (2, S & ASCII.LF, S'Length + 1);
Write (2, S & ASCII.LF, S'Length + 1);
end Put_Line;
----------------------
......@@ -297,4 +294,11 @@ package body System.Tasking.Debug is
end if;
end Trace;
procedure Write (Fd : Integer; S : String; Count : Integer) is
Num : Integer;
begin
Num := System.CRTL.write (Fd, S (S'First)'Address, Count);
end Write;
end System.Tasking.Debug;
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