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 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,8 @@ ...@@ -36,6 +36,8 @@
with Unchecked_Conversion; with Unchecked_Conversion;
package body Interfaces.C_Streams is package body Interfaces.C_Streams is
use type System.CRTL.size_t;
------------ ------------
-- fread -- -- fread --
------------ ------------
...@@ -154,14 +156,6 @@ package body Interfaces.C_Streams is ...@@ -154,14 +156,6 @@ package body Interfaces.C_Streams is
size : size_t) size : size_t)
return int return int
is 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; use type System.Address;
begin begin
...@@ -173,9 +167,11 @@ package body Interfaces.C_Streams is ...@@ -173,9 +167,11 @@ package body Interfaces.C_Streams is
if mode = IONBF if mode = IONBF
and then (stream = stdout or else stream = stderr) and then (stream = stdout or else stream = stderr)
then then
return C_setvbuf (stream, buffer, IOLBF, size); return System.CRTL.setvbuf
(stream, buffer, IOLBF, System.CRTL.size_t (size));
else else
return C_setvbuf (stream, buffer, mode, size); return System.CRTL.setvbuf
(stream, buffer, mode, System.CRTL.size_t (size));
end if; end if;
end setvbuf; 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> 2003-12-11 Ed Falis <falis@gnat.com>
* 5zinit.adb: Clean up. * 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 \ ...@@ -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/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/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/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 # Object files for gnat executables
GNAT1_ADA_OBJS = $(GNAT_ADA_OBJS) ada/back_end.o ada/gnat1drv.o GNAT1_ADA_OBJS = $(GNAT_ADA_OBJS) ada/back_end.o ada/gnat1drv.o
...@@ -212,6 +212,7 @@ GNATBIND_OBJS = \ ...@@ -212,6 +212,7 @@ GNATBIND_OBJS = \
ada/s-carun8.o \ ada/s-carun8.o \
ada/s-casuti.o \ ada/s-casuti.o \
ada/s-crc32.o \ ada/s-crc32.o \
ada/s-crtl.o \
ada/s-except.o \ ada/s-except.o \
ada/s-exctab.o \ ada/s-exctab.o \
ada/s-htable.o \ ada/s-htable.o \
...@@ -2254,10 +2255,10 @@ ada/g-htable.o : ada/gnat.ads ada/g-htable.ads ada/g-htable.adb \ ...@@ -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.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/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-casuti.ads ada/s-crtl.ads ada/s-exctab.ads ada/s-exctab.adb \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ ada/s-htable.ads ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-traent.ads ada/unchconv.ads \ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/unchdeal.ads 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/g-speche.o : ada/gnat.ads ada/g-speche.ads ada/g-speche.adb \
ada/system.ads ada/system.ads
...@@ -2711,6 +2712,8 @@ ada/s-casuti.o : ada/system.ads ada/s-casuti.ads ada/s-casuti.adb ...@@ -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.o : ada/interfac.ads ada/system.ads ada/s-crc32.ads \
ada/s-crc32.adb 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.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 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 \ ...@@ -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-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.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-crtl.ads ada/s-memory.ads ada/s-memory.adb ada/s-parame.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-traent.ads ada/unchconv.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 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 \ ...@@ -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-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-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-crtl.ads 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/s-stache.adb ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/unchconv.ads ada/s-traent.ads ada/unchconv.ads
ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.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 \ 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))),) ...@@ -1123,7 +1123,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
LIBRARY_VERSION := $(LIB_VERSION) LIBRARY_VERSION := $(LIB_VERSION)
endif endif
ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(host))),) ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
soext = .exe soext = .exe
...@@ -1134,17 +1134,32 @@ soext = .exe ...@@ -1134,17 +1134,32 @@ soext = .exe
endif endif
ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),) 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 else
ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),) ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS_AUX = \ LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-parame.ads<5xparame.ads s-parame.ads<5xparame.ads
else else
LIBGNAT_TARGET_PAIRS_AUX = \ LIBGNAT_TARGET_PAIRS_AUX = \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-parame.ads<5vparame.ads s-parame.ads<5vparame.ads
endif endif
endif endif
endif
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-caldel.adb<4vcaldel.adb \ a-caldel.adb<4vcaldel.adb \
...@@ -1152,6 +1167,7 @@ endif ...@@ -1152,6 +1167,7 @@ endif
a-calend.ads<4vcalend.ads \ a-calend.ads<4vcalend.ads \
a-excpol.adb<4wexcpol.adb \ a-excpol.adb<4wexcpol.adb \
a-intnam.ads<4vintnam.ads \ a-intnam.ads<4vintnam.ads \
a-numaux.ads<4vnumaux.ads \
g-expect.adb<3vexpect.adb \ g-expect.adb<3vexpect.adb \
g-soccon.ads<3vsoccon.ads \ g-soccon.ads<3vsoccon.ads \
g-socthi.ads<3vsocthi.ads \ g-socthi.ads<3vsocthi.ads \
...@@ -1161,12 +1177,11 @@ endif ...@@ -1161,12 +1177,11 @@ endif
i-cpp.adb<6vcpp.adb \ i-cpp.adb<6vcpp.adb \
interfac.ads<6vinterf.ads \ interfac.ads<6vinterf.ads \
s-asthan.adb<5vasthan.adb \ s-asthan.adb<5vasthan.adb \
s-crtl.ads<5vcrtl.ads \
s-inmaop.adb<5vinmaop.adb \ s-inmaop.adb<5vinmaop.adb \
s-interr.adb<5vinterr.adb \ s-interr.adb<5vinterr.adb \
s-intman.adb<5vintman.adb \ s-intman.adb<5vintman.adb \
s-intman.ads<5vintman.ads \ s-intman.ads<5vintman.ads \
s-osinte.adb<5vosinte.adb \
s-osinte.ads<5vosinte.ads \
s-osprim.adb<5vosprim.adb \ s-osprim.adb<5vosprim.adb \
s-osprim.ads<5vosprim.ads \ s-osprim.ads<5vosprim.ads \
s-taprop.adb<5vtaprop.adb \ s-taprop.adb<5vtaprop.adb \
......
gcc/ada/Makefile.rtl
# Makefile.rtl for GNU Ada Compiler (GNAT). # 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. #This file is part of GCC.
...@@ -283,6 +283,7 @@ GNATRTL_NONTASKING_OBJS= \ ...@@ -283,6 +283,7 @@ GNATRTL_NONTASKING_OBJS= \
s-caun32$(objext) \ s-caun32$(objext) \
s-caun64$(objext) \ s-caun64$(objext) \
s-chepoo$(objext) \ s-chepoo$(objext) \
s-crtl$(objext) \
s-crc32$(objext) \ s-crc32$(objext) \
s-direio$(objext) \ s-direio$(objext) \
s-errrep$(objext) \ s-errrep$(objext) \
......
gcc/ada/a-direio.adb
...@@ -38,6 +38,7 @@ ...@@ -38,6 +38,7 @@
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System; with System; use System;
with System.CRTL;
with System.File_Control_Block; with System.File_Control_Block;
with System.File_IO; with System.File_IO;
with System.Direct_IO; with System.Direct_IO;
...@@ -65,6 +66,8 @@ package body Ada.Direct_IO is ...@@ -65,6 +66,8 @@ package body Ada.Direct_IO is
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode); function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode); function To_DIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type System.CRTL.size_t;
----------- -----------
-- Close -- -- Close --
----------- -----------
......
gcc/ada/a-sequio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -38,6 +38,7 @@ ...@@ -38,6 +38,7 @@
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; with System;
with System.CRTL;
with System.File_Control_Block; with System.File_Control_Block;
with System.File_IO; with System.File_IO;
with System.Storage_Elements; with System.Storage_Elements;
...@@ -58,6 +59,8 @@ package body Ada.Sequential_IO is ...@@ -58,6 +59,8 @@ package body Ada.Sequential_IO is
function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode); function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
function To_SIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode); function To_SIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type System.CRTL.size_t;
----------- -----------
-- Close -- -- Close --
----------- -----------
......
gcc/ada/a-ststio.adb
...@@ -35,6 +35,7 @@ with Interfaces.C_Streams; use Interfaces.C_Streams; ...@@ -35,6 +35,7 @@ with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System; with System; use System;
with System.File_IO; with System.File_IO;
with System.Soft_Links; with System.Soft_Links;
with System.CRTL;
with Unchecked_Conversion; with Unchecked_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -382,8 +383,11 @@ package body Ada.Streams.Stream_IO is ...@@ -382,8 +383,11 @@ package body Ada.Streams.Stream_IO is
------------------ ------------------
procedure Set_Position (File : in File_Type) is procedure Set_Position (File : in File_Type) is
use type System.CRTL.long;
begin 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; raise Use_Error;
end if; end if;
end Set_Position; end Set_Position;
......
gcc/ada/a-textio.adb
...@@ -35,6 +35,7 @@ with Ada.Streams; use Ada.Streams; ...@@ -35,6 +35,7 @@ with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; with System;
with System.File_IO; with System.File_IO;
with System.CRTL;
with Unchecked_Conversion; with Unchecked_Conversion;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -51,6 +52,8 @@ package body Ada.Text_IO is ...@@ -51,6 +52,8 @@ package body Ada.Text_IO is
function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode); function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type FCB.File_Mode; use type FCB.File_Mode;
use type System.CRTL.size_t;
------------------- -------------------
-- AFCB_Allocate -- -- AFCB_Allocate --
------------------- -------------------
......
gcc/ada/a-witeio.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,7 @@ with Ada.Streams; use Ada.Streams; ...@@ -36,6 +36,7 @@ with Ada.Streams; use Ada.Streams;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; with System;
with System.CRTL;
with System.File_IO; with System.File_IO;
with System.WCh_Cnv; use System.WCh_Cnv; with System.WCh_Cnv; use System.WCh_Cnv;
with System.WCh_Con; use System.WCh_Con; with System.WCh_Con; use System.WCh_Con;
...@@ -55,6 +56,8 @@ package body Ada.Wide_Text_IO is ...@@ -55,6 +56,8 @@ package body Ada.Wide_Text_IO is
function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode); function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
use type FCB.File_Mode; use type FCB.File_Mode;
use type System.CRTL.size_t;
WC_Encoding : Character; WC_Encoding : Character;
pragma Import (C, WC_Encoding, "__gl_wc_encoding"); pragma Import (C, WC_Encoding, "__gl_wc_encoding");
......
gcc/ada/exp_ch6.adb
...@@ -2992,7 +2992,7 @@ package body Exp_Ch6 is ...@@ -2992,7 +2992,7 @@ package body Exp_Ch6 is
Make_Integer_Literal (Loc, Make_Integer_Literal (Loc,
Intval => Intval =>
Expr_Value Expr_Value
(Expression (RTE (RE_Default_Secondary_Stack_Size)))); (Constant_Value (RTE (RE_Default_Secondary_Stack_Size))));
end if; end if;
Sec_Stack_Len := Convert_To (RTE (RE_Storage_Offset), Sec_Stack_Len); Sec_Stack_Len := Convert_To (RTE (RE_Storage_Offset), Sec_Stack_Len);
......
gcc/ada/g-os_lib.adb
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with System.Case_Util; with System.Case_Util;
with System.CRTL;
with System.Soft_Links; with System.Soft_Links;
with Unchecked_Conversion; with Unchecked_Conversion;
with System; use System; with System; use System;
...@@ -82,8 +83,7 @@ package body GNAT.OS_Lib is ...@@ -82,8 +83,7 @@ package body GNAT.OS_Lib is
function To_Path_String_Access function To_Path_String_Access
(Path_Addr : Address; (Path_Addr : Address;
Path_Len : Integer) Path_Len : Integer) return String_Access;
return String_Access;
-- Converts a C String to an Ada String. We could do this making use of -- 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 -- Interfaces.C.Strings but we prefer not to import that entire package
...@@ -143,8 +143,7 @@ package body GNAT.OS_Lib is ...@@ -143,8 +143,7 @@ package body GNAT.OS_Lib is
----------------------------- -----------------------------
function Argument_String_To_List function Argument_String_To_List
(Arg_String : String) (Arg_String : String) return Argument_List_Access
return Argument_List_Access
is is
Max_Args : constant Integer := Arg_String'Length; Max_Args : constant Integer := Arg_String'Length;
New_Argv : Argument_List (1 .. Max_Args); New_Argv : Argument_List (1 .. Max_Args);
...@@ -397,8 +396,7 @@ package body GNAT.OS_Lib is ...@@ -397,8 +396,7 @@ package body GNAT.OS_Lib is
function Copy_Attributes function Copy_Attributes
(From, To : System.Address; (From, To : System.Address;
Mode : Integer) Mode : Integer) return Integer;
return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps. -- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes -- Mode = 1 - copy time stamps and read/write/execute attributes
...@@ -558,8 +556,7 @@ package body GNAT.OS_Lib is ...@@ -558,8 +556,7 @@ package body GNAT.OS_Lib is
function Copy_Attributes function Copy_Attributes
(From, To : System.Address; (From, To : System.Address;
Mode : Integer) Mode : Integer) return Integer;
return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps. -- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes -- Mode = 1 - copy time stamps and read/write/execute attributes
...@@ -611,13 +608,11 @@ package body GNAT.OS_Lib is ...@@ -611,13 +608,11 @@ package body GNAT.OS_Lib is
function Create_File function Create_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
function C_Create_File function C_Create_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_open_create"); pragma Import (C, C_Create_File, "__gnat_open_create");
begin begin
...@@ -626,8 +621,7 @@ package body GNAT.OS_Lib is ...@@ -626,8 +621,7 @@ package body GNAT.OS_Lib is
function Create_File function Create_File
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
...@@ -643,13 +637,11 @@ package body GNAT.OS_Lib is ...@@ -643,13 +637,11 @@ package body GNAT.OS_Lib is
function Create_New_File function Create_New_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
function C_Create_New_File function C_Create_New_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
pragma Import (C, C_Create_New_File, "__gnat_open_new"); pragma Import (C, C_Create_New_File, "__gnat_open_new");
begin begin
...@@ -658,8 +650,7 @@ package body GNAT.OS_Lib is ...@@ -658,8 +650,7 @@ package body GNAT.OS_Lib is
function Create_New_File function Create_New_File
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
...@@ -679,8 +670,7 @@ package body GNAT.OS_Lib is ...@@ -679,8 +670,7 @@ package body GNAT.OS_Lib is
is is
function Open_New_Temp function Open_New_Temp
(Name : System.Address; (Name : System.Address;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
pragma Import (C, Open_New_Temp, "__gnat_open_new_temp"); pragma Import (C, Open_New_Temp, "__gnat_open_new_temp");
begin begin
...@@ -1225,8 +1215,7 @@ package body GNAT.OS_Lib is ...@@ -1225,8 +1215,7 @@ package body GNAT.OS_Lib is
------------------------- -------------------------
function Locate_Exec_On_Path function Locate_Exec_On_Path
(Exec_Name : String) (Exec_Name : String) return String_Access
return String_Access
is is
function Locate_Exec_On_Path (C_Exec_Name : Address) return Address; function Locate_Exec_On_Path (C_Exec_Name : Address) return Address;
pragma Import (C, Locate_Exec_On_Path, "__gnat_locate_exec_on_path"); pragma Import (C, Locate_Exec_On_Path, "__gnat_locate_exec_on_path");
...@@ -1262,8 +1251,7 @@ package body GNAT.OS_Lib is ...@@ -1262,8 +1251,7 @@ package body GNAT.OS_Lib is
function Locate_Regular_File function Locate_Regular_File
(File_Name : C_File_Name; (File_Name : C_File_Name;
Path : C_File_Name) Path : C_File_Name) return String_Access
return String_Access
is is
function Locate_Regular_File function Locate_Regular_File
(C_File_Name, Path_Val : Address) return Address; (C_File_Name, Path_Val : Address) return Address;
...@@ -1291,8 +1279,7 @@ package body GNAT.OS_Lib is ...@@ -1291,8 +1279,7 @@ package body GNAT.OS_Lib is
function Locate_Regular_File function Locate_Regular_File
(File_Name : String; (File_Name : String;
Path : String) Path : String) return String_Access
return String_Access
is is
C_File_Name : String (1 .. File_Name'Length + 1); C_File_Name : String (1 .. File_Name'Length + 1);
C_Path : String (1 .. Path'Length + 1); C_Path : String (1 .. Path'Length + 1);
...@@ -1313,8 +1300,7 @@ package body GNAT.OS_Lib is ...@@ -1313,8 +1300,7 @@ package body GNAT.OS_Lib is
function Non_Blocking_Spawn function Non_Blocking_Spawn
(Program_Name : String; (Program_Name : String;
Args : Argument_List) Args : Argument_List) return Process_Id
return Process_Id
is is
Junk : Integer; Junk : Integer;
Pid : Process_Id; Pid : Process_Id;
...@@ -1428,8 +1414,7 @@ package body GNAT.OS_Lib is ...@@ -1428,8 +1414,7 @@ package body GNAT.OS_Lib is
(Name : String; (Name : String;
Directory : String := ""; Directory : String := "";
Resolve_Links : Boolean := True; Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) Case_Sensitive : Boolean := True) return String
return String
is is
Max_Path : Integer; Max_Path : Integer;
pragma Import (C, Max_Path, "__gnat_max_path_len"); pragma Import (C, Max_Path, "__gnat_max_path_len");
...@@ -1465,13 +1450,11 @@ package body GNAT.OS_Lib is ...@@ -1465,13 +1450,11 @@ package body GNAT.OS_Lib is
function Readlink function Readlink
(Path : System.Address; (Path : System.Address;
Buf : System.Address; Buf : System.Address;
Bufsiz : Integer) Bufsiz : Integer) return Integer;
return Integer;
pragma Import (C, Readlink, "__gnat_readlink"); pragma Import (C, Readlink, "__gnat_readlink");
function To_Canonical_File_Spec function To_Canonical_File_Spec
(Host_File : System.Address) (Host_File : System.Address) return System.Address;
return System.Address;
pragma Import pragma Import
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec"); (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
...@@ -1909,13 +1892,11 @@ package body GNAT.OS_Lib is ...@@ -1909,13 +1892,11 @@ package body GNAT.OS_Lib is
function Open_Read function Open_Read
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
function C_Open_Read function C_Open_Read
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
pragma Import (C, C_Open_Read, "__gnat_open_read"); pragma Import (C, C_Open_Read, "__gnat_open_read");
begin begin
...@@ -1924,8 +1905,7 @@ package body GNAT.OS_Lib is ...@@ -1924,8 +1905,7 @@ package body GNAT.OS_Lib is
function Open_Read function Open_Read
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
...@@ -1941,13 +1921,11 @@ package body GNAT.OS_Lib is ...@@ -1941,13 +1921,11 @@ package body GNAT.OS_Lib is
function Open_Read_Write function Open_Read_Write
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
function C_Open_Read_Write function C_Open_Read_Write
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
pragma Import (C, C_Open_Read_Write, "__gnat_open_rw"); pragma Import (C, C_Open_Read_Write, "__gnat_open_rw");
begin begin
...@@ -1956,8 +1934,7 @@ package body GNAT.OS_Lib is ...@@ -1956,8 +1934,7 @@ package body GNAT.OS_Lib is
function Open_Read_Write function Open_Read_Write
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor
return File_Descriptor
is is
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
...@@ -1967,6 +1944,20 @@ package body GNAT.OS_Lib is ...@@ -1967,6 +1944,20 @@ package body GNAT.OS_Lib is
return Open_Read_Write (C_Name (C_Name'First)'Address, Fmode); return Open_Read_Write (C_Name (C_Name'First)'Address, Fmode);
end Open_Read_Write; 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 -- -- Rename_File --
----------------- -----------------
...@@ -2031,8 +2022,7 @@ package body GNAT.OS_Lib is ...@@ -2031,8 +2022,7 @@ package body GNAT.OS_Lib is
function Spawn function Spawn
(Program_Name : String; (Program_Name : String;
Args : Argument_List) Args : Argument_List) return Integer
return Integer
is is
Junk : Process_Id; Junk : Process_Id;
Result : Integer; Result : Integer;
...@@ -2173,8 +2163,7 @@ package body GNAT.OS_Lib is ...@@ -2173,8 +2163,7 @@ package body GNAT.OS_Lib is
function To_Path_String_Access function To_Path_String_Access
(Path_Addr : Address; (Path_Addr : Address;
Path_Len : Integer) Path_Len : Integer) return String_Access
return String_Access
is is
subtype Path_String is String (1 .. Path_Len); subtype Path_String is String (1 .. Path_Len);
type Path_String_Access is access Path_String; type Path_String_Access is access Path_String;
...@@ -2213,4 +2202,18 @@ package body GNAT.OS_Lib is ...@@ -2213,4 +2202,18 @@ package body GNAT.OS_Lib is
Success := (Status = 0); Success := (Status = 0);
end Wait_Process; 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; end GNAT.OS_Lib;
gcc/ada/g-os_lib.ads
...@@ -175,31 +175,27 @@ pragma Elaborate_Body (OS_Lib); ...@@ -175,31 +175,27 @@ pragma Elaborate_Body (OS_Lib);
function Open_Read function Open_Read
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
-- Open file Name for reading, returning file descriptor File descriptor -- Open file Name for reading, returning file descriptor File descriptor
-- returned is Invalid_FD if file cannot be opened. -- returned is Invalid_FD if file cannot be opened.
function Open_Read_Write function Open_Read_Write
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
-- Open file Name for both reading and writing, returning file -- Open file Name for both reading and writing, returning file
-- descriptor. File descriptor returned is Invalid_FD if file cannot be -- descriptor. File descriptor returned is Invalid_FD if file cannot be
-- opened. -- opened.
function Create_File function Create_File
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
-- Creates new file with given name for writing, returning file descriptor -- Creates new file with given name for writing, returning file descriptor
-- for subsequent use in Write calls. File descriptor returned is -- for subsequent use in Write calls. File descriptor returned is
-- Invalid_FD if file cannot be successfully created -- Invalid_FD if file cannot be successfully created
function Create_New_File function Create_New_File
(Name : String; (Name : String;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
-- Create new file with given name for writing, returning 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 -- for subsequent use in Write calls. This differs from Create_File in
-- that it fails if the file already exists. File descriptor returned is -- that it fails if the file already exists. File descriptor returned is
...@@ -334,18 +330,14 @@ pragma Elaborate_Body (OS_Lib); ...@@ -334,18 +330,14 @@ pragma Elaborate_Body (OS_Lib);
function Read function Read
(FD : File_Descriptor; (FD : File_Descriptor;
A : System.Address; A : System.Address;
N : Integer) N : Integer) return Integer;
return Integer;
pragma Import (C, Read, "read");
-- Read N bytes to address A from file referenced by FD. Returned value -- 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. -- is count of bytes actually read, which can be less than N at EOF.
function Write function Write
(FD : File_Descriptor; (FD : File_Descriptor;
A : System.Address; A : System.Address;
N : Integer) N : Integer) return Integer;
return Integer;
pragma Import (C, Write, "write");
-- Write N bytes from address A to file referenced by FD. The returned -- 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 -- value is the number of bytes written, which can be less than N if
-- a disk full condition was detected. -- a disk full condition was detected.
...@@ -379,8 +371,7 @@ pragma Elaborate_Body (OS_Lib); ...@@ -379,8 +371,7 @@ pragma Elaborate_Body (OS_Lib);
(Name : String; (Name : String;
Directory : String := ""; Directory : String := "";
Resolve_Links : Boolean := True; Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) Case_Sensitive : Boolean := True) return String;
return String;
-- Returns a file name as an absolute path name, resolving all relative -- Returns a file name as an absolute path name, resolving all relative
-- directories, and symbolic links. The parameter Directory is a fully -- directories, and symbolic links. The parameter Directory is a fully
-- resolved path name for a directory, or the empty string (the default). -- resolved path name for a directory, or the empty string (the default).
...@@ -458,8 +449,7 @@ pragma Elaborate_Body (OS_Lib); ...@@ -458,8 +449,7 @@ pragma Elaborate_Body (OS_Lib);
-- span file systems and may refer to directories. -- span file systems and may refer to directories.
function Locate_Exec_On_Path function Locate_Exec_On_Path
(Exec_Name : String) (Exec_Name : String) return String_Access;
return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the -- 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 -- directories listed in the environment Path. If the Exec_Name doesn't
-- have the executable suffix, it will be appended before the search. -- have the executable suffix, it will be appended before the search.
...@@ -470,8 +460,7 @@ pragma Elaborate_Body (OS_Lib); ...@@ -470,8 +460,7 @@ pragma Elaborate_Body (OS_Lib);
function Locate_Regular_File function Locate_Regular_File
(File_Name : String; (File_Name : String;
Path : String) Path : String) return String_Access;
return String_Access;
-- Try to locate a regular file whose name is given by File_Name in the -- 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 -- 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 -- returned; otherwise, a null pointer is returned. If the File_Name given
...@@ -511,25 +500,23 @@ pragma Elaborate_Body (OS_Lib); ...@@ -511,25 +500,23 @@ pragma Elaborate_Body (OS_Lib);
-- This subtype is used to document that a parameter is the address -- This subtype is used to document that a parameter is the address
-- of a null-terminated string containing the name of a file. -- of a null-terminated string containing the name of a file.
-- All the following functions need comments ???
function Open_Read function Open_Read
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
function Open_Read_Write function Open_Read_Write
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
function Create_File function Create_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
function Create_New_File function Create_New_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) Fmode : Mode) return File_Descriptor;
return File_Descriptor;
procedure Delete_File (Name : C_File_Name; Success : out Boolean); procedure Delete_File (Name : C_File_Name; Success : out Boolean);
......
gcc/ada/gnatchop.adb
...@@ -342,10 +342,10 @@ procedure Gnatchop is ...@@ -342,10 +342,10 @@ procedure Gnatchop is
if not Warning then if not Warning then
Set_Exit_Status (Failure); Set_Exit_Status (Failure);
end if;
if Exit_On_Error then if Exit_On_Error then
raise Terminate_Program; raise Terminate_Program;
end if;
end if; end if;
end Error_Msg; end Error_Msg;
...@@ -1738,7 +1738,7 @@ begin ...@@ -1738,7 +1738,7 @@ begin
declare declare
Warnings_Msg : String := Warning_Count'Img & " warning(s)"; Warnings_Msg : String := Warning_Count'Img & " warning(s)";
begin begin
Error_Msg (Warnings_Msg (2 .. Warnings_Msg'Last)); Error_Msg (Warnings_Msg (2 .. Warnings_Msg'Last), Warning => True);
end; end;
end if; end if;
......
gcc/ada/gnatlink.adb
...@@ -42,6 +42,7 @@ with Types; ...@@ -42,6 +42,7 @@ with Types;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Command_Line; use Ada.Command_Line;
with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.OS_Lib; use GNAT.OS_Lib;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL;
procedure Gnatlink is procedure Gnatlink is
pragma Ident (Gnatvsn.Gnat_Static_Version_String); pragma Ident (Gnatvsn.Gnat_Static_Version_String);
...@@ -770,6 +771,7 @@ procedure Gnatlink is ...@@ -770,6 +771,7 @@ procedure Gnatlink is
------------------------ ------------------------
procedure Store_File_Context is procedure Store_File_Context is
use type System.CRTL.long;
begin begin
RB_Next_Line := Next_Line; RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst; RB_Nfirst := Nfirst;
......
gcc/ada/i-cstrea.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,6 +39,8 @@ with Unchecked_Conversion; ...@@ -39,6 +39,8 @@ with Unchecked_Conversion;
package body Interfaces.C_Streams is package body Interfaces.C_Streams is
use type System.CRTL.size_t;
------------ ------------
-- fread -- -- fread --
------------ ------------
......
gcc/ada/i-cstrea.ads
...@@ -34,38 +34,17 @@ ...@@ -34,38 +34,17 @@
-- This package is a thin binding to selected functions in the C -- This package is a thin binding to selected functions in the C
-- library that provide a complete interface for handling C streams. -- library that provide a complete interface for handling C streams.
with System.Parameters; with System.CRTL;
package Interfaces.C_Streams is package Interfaces.C_Streams is
pragma Preelaborate; pragma Preelaborate;
-- Note: the reason we do not use the types that are in Interfaces.C is subtype chars is System.CRTL.chars;
-- that we want to avoid dragging in the code in this unit if possible. subtype FILEs is System.CRTL.FILEs;
subtype int is System.CRTL.int;
subtype chars is System.Address; subtype long is System.CRTL.long;
-- Pointer to null-terminated array of characters subtype size_t is System.CRTL.size_t;
subtype FILEs is System.Address;
-- Corresponds to the C type FILE*
subtype voids is System.Address; 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; NULL_Stream : constant FILEs;
-- Value returned (NULL in C) to indicate an fdopen/fopen/tmpfile error -- Value returned (NULL in C) to indicate an fdopen/fopen/tmpfile error
...@@ -106,34 +85,39 @@ package Interfaces.C_Streams is ...@@ -106,34 +85,39 @@ package Interfaces.C_Streams is
-- Library Reference" (Microsoft Press, 1990, ISBN 1-55615-225-6), -- Library Reference" (Microsoft Press, 1990, ISBN 1-55615-225-6),
-- which includes useful information on system compatibility. -- 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 feof (stream : FILEs) return int;
function ferror (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 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, -- Note: to maintain target independence, use text_translation_required,
-- a boolean variable defined in a-sysdep.c to deal with the target -- a boolean variable defined in a-sysdep.c to deal with the target
-- dependent text translation requirement. If this variable is set, -- dependent text translation requirement. If this variable is set,
-- then b/t should be appended to the standard mode argument to set -- then b/t should be appended to the standard mode argument to set
-- the text translation mode off or on as required. -- 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 function fread
(buffer : voids; (buffer : voids;
...@@ -159,15 +143,16 @@ package Interfaces.C_Streams is ...@@ -159,15 +143,16 @@ package Interfaces.C_Streams is
(filename : chars; (filename : chars;
mode : chars; mode : chars;
stream : FILEs) stream : FILEs)
return FILEs; return FILEs renames System.CRTL.freopen;
function fseek function fseek
(stream : FILEs; (stream : FILEs;
offset : long; offset : long;
origin : int) 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 function fwrite
(buffer : voids; (buffer : voids;
...@@ -176,12 +161,12 @@ package Interfaces.C_Streams is ...@@ -176,12 +161,12 @@ package Interfaces.C_Streams is
stream : FILEs) stream : FILEs)
return size_t; 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 -- 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 function setvbuf
(stream : FILEs; (stream : FILEs;
...@@ -190,16 +175,18 @@ package Interfaces.C_Streams is ...@@ -190,16 +175,18 @@ package Interfaces.C_Streams is
size : size_t) size : size_t)
return int; 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 -- 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 -- bytes (the call with a null parameter is not supported). The returned
-- value, which is just a copy of the input argument, is discarded. -- 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 -- -- Extra functions --
...@@ -253,29 +240,6 @@ private ...@@ -253,29 +240,6 @@ private
pragma Inline (fwrite); pragma Inline (fwrite);
pragma Inline (setvbuf); 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, file_exists, "__gnat_file_exists");
pragma Import (C, is_regular_file, "__gnat_is_regular_file_fd"); 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 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System; use System; with System; use System;
with System.CRTL;
with System.File_IO; with System.File_IO;
with System.Soft_Links; with System.Soft_Links;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -46,6 +47,9 @@ package body System.Direct_IO is ...@@ -46,6 +47,9 @@ package body System.Direct_IO is
subtype AP is FCB.AFCB_Ptr; subtype AP is FCB.AFCB_Ptr;
use type FCB.Shared_Status_Type; use type FCB.Shared_Status_Type;
use type System.CRTL.long;
use type System.CRTL.size_t;
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
......
gcc/ada/s-fileio.adb
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL;
with System.Soft_Links; with System.Soft_Links;
with Unchecked_Deallocation; with Unchecked_Deallocation;
...@@ -43,6 +44,8 @@ package body System.File_IO is ...@@ -43,6 +44,8 @@ package body System.File_IO is
package SSL renames System.Soft_Links; package SSL renames System.Soft_Links;
use type System.CRTL.size_t;
---------------------- ----------------------
-- Global Variables -- -- Global Variables --
---------------------- ----------------------
......
gcc/ada/s-memcop.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -35,24 +35,27 @@ ...@@ -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 -- 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 package System.Memory_Copy is
pragma Preelaborate; pragma Preelaborate;
type size_t is mod 2 ** Standard'Address_Size; procedure memcpy (S1 : Address; S2 : Address; N : System.CRTL.size_t)
-- Note: the reason we redefine this here instead of using the renames System.CRTL.memcpy;
-- 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);
-- Copies N storage units from area starting at S2 to area starting -- Copies N storage units from area starting at S2 to area starting
-- at S1 without any check for buffer overflow. The memory areas -- at S1 without any check for buffer overflow. The memory areas
-- must not overlap, or the result of this call is undefined. -- 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 -- Copies N storage units from area starting at S2 to area starting
-- at S1 without any check for buffer overflow. The difference between -- at S1 without any check for buffer overflow. The difference between
-- this memmove and memcpy is that with memmove, the storage areas may -- this memmove and memcpy is that with memmove, the storage areas may
...@@ -60,8 +63,6 @@ pragma Preelaborate; ...@@ -60,8 +63,6 @@ pragma Preelaborate;
-- is as if S2 is first moved to a temporary area, and then this area -- is as if S2 is first moved to a temporary area, and then this area
-- is copied to S1 in a separate step). -- is copied to S1 in a separate step).
private
-- In the standard library, these are just interfaced to the C routines. -- 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 -- But in the HI-E (high integrity version) they may be reprogrammed to
-- meet certification requirements (and marked High_Integrity). -- meet certification requirements (and marked High_Integrity).
...@@ -70,7 +71,4 @@ private ...@@ -70,7 +71,4 @@ private
-- available, and the HI-E compiler will as a result generate implicit -- available, and the HI-E compiler will as a result generate implicit
-- loops (which will violate the restriction No_Implicit_Loops). -- loops (which will violate the restriction No_Implicit_Loops).
pragma Import (C, memcpy, "memcpy");
pragma Import (C, memmove, "memmove");
end System.Memory_Copy; end System.Memory_Copy;
gcc/ada/s-memory.adb
...@@ -46,21 +46,22 @@ ...@@ -46,21 +46,22 @@
with Ada.Exceptions; with Ada.Exceptions;
with System.Soft_Links; with System.Soft_Links;
with System.Parameters; with System.Parameters;
with System.CRTL;
package body System.Memory is package body System.Memory is
use Ada.Exceptions; use Ada.Exceptions;
use System.Soft_Links; use System.Soft_Links;
function c_malloc (Size : size_t) return System.Address; function c_malloc (Size : System.CRTL.size_t) return System.Address
pragma Import (C, c_malloc, "malloc"); renames System.CRTL.malloc;
procedure c_free (Ptr : System.Address); procedure c_free (Ptr : System.Address)
pragma Import (C, c_free, "free"); renames System.CRTL.free;
function c_realloc function c_realloc
(Ptr : System.Address; Size : size_t) return System.Address; (Ptr : System.Address; Size : System.CRTL.size_t) return System.Address
pragma Import (C, c_realloc, "realloc"); renames System.CRTL.realloc;
----------- -----------
-- Alloc -- -- Alloc --
...@@ -85,10 +86,10 @@ package body System.Memory is ...@@ -85,10 +86,10 @@ package body System.Memory is
end if; end if;
if Parameters.No_Abort then if Parameters.No_Abort then
Result := c_malloc (Actual_Size); Result := c_malloc (System.CRTL.size_t (Actual_Size));
else else
Abort_Defer.all; Abort_Defer.all;
Result := c_malloc (Actual_Size); Result := c_malloc (System.CRTL.size_t (Actual_Size));
Abort_Undefer.all; Abort_Undefer.all;
end if; end if;
...@@ -132,10 +133,10 @@ package body System.Memory is ...@@ -132,10 +133,10 @@ package body System.Memory is
end if; end if;
if Parameters.No_Abort then if Parameters.No_Abort then
Result := c_realloc (Ptr, Actual_Size); Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
else else
Abort_Defer.all; Abort_Defer.all;
Result := c_realloc (Ptr, Actual_Size); Result := c_realloc (Ptr, System.CRTL.size_t (Actual_Size));
Abort_Undefer.all; Abort_Undefer.all;
end if; end if;
......
gcc/ada/s-stache.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,6 +36,7 @@ with Ada.Exceptions; ...@@ -36,6 +36,7 @@ with Ada.Exceptions;
with System.Storage_Elements; use System.Storage_Elements; with System.Storage_Elements; use System.Storage_Elements;
with System.Parameters; use System.Parameters; with System.Parameters; use System.Parameters;
with System.Soft_Links; with System.Soft_Links;
with System.CRTL;
package body System.Stack_Checking is package body System.Stack_Checking is
...@@ -72,7 +73,6 @@ 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 procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
pragma Warnings (Off, Any_Stack); pragma Warnings (Off, Any_Stack);
begin begin
Cache := Null_Stack; Cache := Null_Stack;
end Invalidate_Stack_Cache; end Invalidate_Stack_Cache;
...@@ -82,8 +82,7 @@ package body System.Stack_Checking is ...@@ -82,8 +82,7 @@ package body System.Stack_Checking is
-------------------- --------------------
function Set_Stack_Info function Set_Stack_Info
(Stack : access Stack_Access) (Stack : access Stack_Access) return Stack_Access
return Stack_Access
is is
type Frame_Mark is null record; type Frame_Mark is null record;
Frame_Location : Frame_Mark; Frame_Location : Frame_Mark;
...@@ -93,12 +92,6 @@ package body System.Stack_Checking is ...@@ -93,12 +92,6 @@ package body System.Stack_Checking is
Limit_Chars : System.Address; Limit_Chars : System.Address;
Limit : Integer; 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 begin
-- The order of steps 1 .. 3 is important, see specification. -- The order of steps 1 .. 3 is important, see specification.
...@@ -113,16 +106,16 @@ package body System.Stack_Checking is ...@@ -113,16 +106,16 @@ package body System.Stack_Checking is
-- the current frame address. -- the current frame address.
if My_Stack.Size = 0 then if My_Stack.Size = 0 then
My_Stack.Size := Storage_Offset (Default_Env_Stack_Size); My_Stack.Size := Storage_Offset (Default_Env_Stack_Size);
-- When the environment variable GNAT_STACK_LIMIT is set, -- When the environment variable GNAT_STACK_LIMIT is set,
-- set Environment_Stack_Size to that number of kB. -- 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 if Limit_Chars /= Null_Address then
Limit := atoi (Limit_Chars); Limit := System.CRTL.atoi (Limit_Chars);
if Limit >= 0 then if Limit >= 0 then
My_Stack.Size := Storage_Offset (Limit) * Kilobyte; My_Stack.Size := Storage_Offset (Limit) * Kilobyte;
end if; end if;
...@@ -192,8 +185,7 @@ package body System.Stack_Checking is ...@@ -192,8 +185,7 @@ package body System.Stack_Checking is
----------------- -----------------
function Stack_Check function Stack_Check
(Stack_Address : System.Address) (Stack_Address : System.Address) return Stack_Access
return Stack_Access
is is
type Frame_Marker is null record; type Frame_Marker is null record;
Marker : Frame_Marker; Marker : Frame_Marker;
...@@ -227,7 +219,6 @@ package body System.Stack_Checking is ...@@ -227,7 +219,6 @@ package body System.Stack_Checking is
-- it is essential to use our local copy of Stack! -- it is essential to use our local copy of Stack!
begin begin
if (Stack_Grows_Down and then if (Stack_Grows_Down and then
(not (Frame_Address <= My_Stack.Base))) (not (Frame_Address <= My_Stack.Base)))
or else or else
......
gcc/ada/s-tasdeb.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -39,14 +39,12 @@ ...@@ -39,14 +39,12 @@
-- Do not add any dependency to GNARL packages since this package is used -- Do not add any dependency to GNARL packages since this package is used
-- in both normal and restricted (ravenscar) environments. -- in both normal and restricted (ravenscar) environments.
with Interfaces.C; with System.CRTL;
with System.Task_Primitives.Operations; with System.Task_Primitives.Operations;
with Unchecked_Conversion; with Unchecked_Conversion;
package body System.Tasking.Debug is package body System.Tasking.Debug is
use Interfaces.C;
package STPO renames System.Task_Primitives.Operations; package STPO renames System.Task_Primitives.Operations;
function To_Integer is new function To_Integer is new
...@@ -60,8 +58,7 @@ package body System.Tasking.Debug is ...@@ -60,8 +58,7 @@ package body System.Tasking.Debug is
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
procedure write (Fd : Integer; S : String; Count : size_t); procedure Write (Fd : Integer; S : String; Count : Integer);
pragma Import (C, write);
procedure Put (S : String); procedure Put (S : String);
-- Display S on standard output. -- Display S on standard output.
...@@ -177,7 +174,7 @@ package body System.Tasking.Debug is ...@@ -177,7 +174,7 @@ package body System.Tasking.Debug is
procedure Put (S : String) is procedure Put (S : String) is
begin begin
write (2, S, S'Length); Write (2, S, S'Length);
end Put; end Put;
-------------- --------------
...@@ -186,7 +183,7 @@ package body System.Tasking.Debug is ...@@ -186,7 +183,7 @@ package body System.Tasking.Debug is
procedure Put_Line (S : String := "") is procedure Put_Line (S : String := "") is
begin begin
write (2, S & ASCII.LF, S'Length + 1); Write (2, S & ASCII.LF, S'Length + 1);
end Put_Line; end Put_Line;
---------------------- ----------------------
...@@ -297,4 +294,11 @@ package body System.Tasking.Debug is ...@@ -297,4 +294,11 @@ package body System.Tasking.Debug is
end if; end if;
end Trace; 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; 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