From 209db2bf05a5830792bc1a2f06c8fedf21285304 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 15 Dec 2003 12:51:01 +0100 Subject: [multiple changes] 2003-12-15 Robert Dewar * exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default sec stack size. 2003-12-15 Vincent Celier * 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 * 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 * Make-lang.in: Makefile automatically updated From-SVN: r74627 --- gcc/ada/6vcstrea.adb | 18 +++--- gcc/ada/ChangeLog | 35 ++++++++++++ gcc/ada/Make-lang.in | 25 ++++---- gcc/ada/Makefile.in | 25 ++++++-- gcc/ada/Makefile.rtl | 3 +- gcc/ada/a-direio.adb | 3 + gcc/ada/a-sequio.adb | 5 +- gcc/ada/a-ststio.adb | 6 +- gcc/ada/a-textio.adb | 3 + gcc/ada/a-witeio.adb | 5 +- gcc/ada/exp_ch6.adb | 2 +- gcc/ada/g-os_lib.adb | 107 +++++++++++++++++----------------- gcc/ada/g-os_lib.ads | 43 +++++--------- gcc/ada/gnatchop.adb | 8 +-- gcc/ada/gnatlink.adb | 2 + gcc/ada/i-cstrea.adb | 4 +- gcc/ada/i-cstrea.ads | 102 +++++++++++---------------------- gcc/ada/s-crtl.ads | 159 +++++++++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-direio.adb | 6 +- gcc/ada/s-fileio.adb | 3 + gcc/ada/s-memcop.ads | 28 +++++---- gcc/ada/s-memory.adb | 21 +++---- gcc/ada/s-stache.adb | 23 +++----- gcc/ada/s-tasdeb.adb | 20 ++++--- 24 files changed, 420 insertions(+), 236 deletions(-) create mode 100644 gcc/ada/s-crtl.ads diff --git a/gcc/ada/6vcstrea.adb b/gcc/ada/6vcstrea.adb index 1a320bc..0469019 100644 --- a/gcc/ada/6vcstrea.adb +++ b/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; diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 91b74c5..25699d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,38 @@ +2003-12-15 Robert Dewar + + * exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default + sec stack size. + +2003-12-15 Vincent Celier + + * 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 + + * 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 + + * Make-lang.in: Makefile automatically updated + 2003-12-11 Ed Falis * 5zinit.adb: Clean up. diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index e165cdb..b7abcdc 100644 --- a/gcc/ada/Make-lang.in +++ b/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 \ diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index acabfec..b20402c 100644 --- a/gcc/ada/Makefile.in +++ b/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 \ diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 445d377..0fabb1d 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -1,5 +1,5 @@ # 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) \ diff --git a/gcc/ada/a-direio.adb b/gcc/ada/a-direio.adb index 310e24f..3c5743b 100644 --- a/gcc/ada/a-direio.adb +++ b/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 -- ----------- diff --git a/gcc/ada/a-sequio.adb b/gcc/ada/a-sequio.adb index 90b543a..7218763 100644 --- a/gcc/ada/a-sequio.adb +++ b/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 -- ----------- diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index 8df6a37..2d5db61 100644 --- a/gcc/ada/a-ststio.adb +++ b/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; diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb index b61ebd3..98766ce 100644 --- a/gcc/ada/a-textio.adb +++ b/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 -- ------------------- diff --git a/gcc/ada/a-witeio.adb b/gcc/ada/a-witeio.adb index 50b1202..621f4bd 100644 --- a/gcc/ada/a-witeio.adb +++ b/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"); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6f3e666..cad54ac 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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); diff --git a/gcc/ada/g-os_lib.adb b/gcc/ada/g-os_lib.adb index 24f6297..d568d36 100644 --- a/gcc/ada/g-os_lib.adb +++ b/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; diff --git a/gcc/ada/g-os_lib.ads b/gcc/ada/g-os_lib.ads index 63ed32f..8b317fd 100644 --- a/gcc/ada/g-os_lib.ads +++ b/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); diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 6855454..7384cd3 100644 --- a/gcc/ada/gnatchop.adb +++ b/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; diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index ed01ba8..5d198c0 100644 --- a/gcc/ada/gnatlink.adb +++ b/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; diff --git a/gcc/ada/i-cstrea.adb b/gcc/ada/i-cstrea.adb index 9d322d4..2c85bc9 100644 --- a/gcc/ada/i-cstrea.adb +++ b/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 -- ------------ diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 4650cdb..39f8af9 100644 --- a/gcc/ada/i-cstrea.ads +++ b/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"); diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads new file mode 100644 index 0000000..cabf610 --- /dev/null +++ b/gcc/ada/s-crtl.ads @@ -0,0 +1,159 @@ +------------------------------------------------------------------------------ +-- -- +-- 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; diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb index 8f43e74..a05461f 100644 --- a/gcc/ada/s-direio.adb +++ b/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 -- ----------------------- diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index b60cce5..cf29b24 100644 --- a/gcc/ada/s-fileio.adb +++ b/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 -- ---------------------- diff --git a/gcc/ada/s-memcop.ads b/gcc/ada/s-memcop.ads index d71d48f..f4d9454 100644 --- a/gcc/ada/s-memcop.ads +++ b/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; diff --git a/gcc/ada/s-memory.adb b/gcc/ada/s-memory.adb index cdbb22e..66637c7 100644 --- a/gcc/ada/s-memory.adb +++ b/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; diff --git a/gcc/ada/s-stache.adb b/gcc/ada/s-stache.adb index 65e816b..aa403c3 100644 --- a/gcc/ada/s-stache.adb +++ b/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 diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb index f8f50b9..baca961 100644 --- a/gcc/ada/s-tasdeb.adb +++ b/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; -- cgit v1.1