-- --
-- 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- --
with Unchecked_Conversion;
package body Interfaces.C_Streams is
+ use type System.CRTL.size_t;
+
------------
-- fread --
------------
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
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;
+2003-12-15 Robert Dewar <dewar@gnat.com>
+
+ * exp_ch6.adb (Expand_Thread_Body): Fix error in picking up default
+ sec stack size.
+
+2003-12-15 Vincent Celier <celier@gnat.com>
+
+ * gnatchop.adb: (Error_Msg): Do not exit on error for a warning
+ (Gnatchop): Do not set failure status when reporting the number of
+ warnings.
+
+2003-12-15 Doug Rupp <rupp@gnat.com>
+
+ * s-ctrl.ads: New file.
+
+ * Makefile.rtl (GNAT_RTL_NONTASKING_OBJS): Add s-crtl$(objext).
+
+ * Make-lang.in: (GNAT_ADA_OBJS): Add ada/s-crtl.o.
+ (GNATBIND_OBJS): Add ada/s-crtl.o.
+
+ * Makefile.in [VMS]: Clean up ifeq rules.
+
+ * gnatlink.adb, 6vcstrea.adb, a-direio.adb, a-sequio.adb,
+ a-ststio.adb, a-textio.adb, g-os_lib.adb, a-witeio.adb,
+ g-os_lib.ads, i-cstrea.adb, i-cstrea.ads, s-direio.adb,
+ s-fileio.adb, s-memcop.ads, s-memory.adb, s-stache.adb,
+ s-tasdeb.adb: Update copyright.
+ Import System.CRTL.
+ Make minor modifications to use System.CRTL declared functions instead
+ of importing locally.
+
+2003-12-15 GNAT Script <nobody@gnat.com>
+
+ * Make-lang.in: Makefile automatically updated
+
2003-12-11 Ed Falis <falis@gnat.com>
* 5zinit.adb: Clean up.
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
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 \
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
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
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
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 \
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
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 \
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 \
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 \
# 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.
s-caun32$(objext) \
s-caun64$(objext) \
s-chepoo$(objext) \
+ s-crtl$(objext) \
s-crc32$(objext) \
s-direio$(objext) \
s-errrep$(objext) \
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;
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 --
-----------
-- --
-- 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- --
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;
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 --
-----------
with System; use System;
with System.File_IO;
with System.Soft_Links;
+with System.CRTL;
with Unchecked_Conversion;
with Unchecked_Deallocation;
------------------
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;
with Interfaces.C_Streams; use Interfaces.C_Streams;
with System;
with System.File_IO;
+with System.CRTL;
with Unchecked_Conversion;
with Unchecked_Deallocation;
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 --
-------------------
-- --
-- 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- --
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;
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");
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);
------------------------------------------------------------------------------
with System.Case_Util;
+with System.CRTL;
with System.Soft_Links;
with Unchecked_Conversion;
with System; use System;
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
-----------------------------
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);
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
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
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
function Create_File
(Name : String;
- Fmode : Mode)
- return File_Descriptor
+ Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
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
function Create_New_File
(Name : String;
- Fmode : Mode)
- return File_Descriptor
+ Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
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
-------------------------
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");
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;
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);
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;
(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");
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");
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
function Open_Read
(Name : String;
- Fmode : Mode)
- return File_Descriptor
+ Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
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
function Open_Read_Write
(Name : String;
- Fmode : Mode)
- return File_Descriptor
+ Fmode : Mode) return File_Descriptor
is
C_Name : String (1 .. Name'Length + 1);
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 --
-----------------
function Spawn
(Program_Name : String;
- Args : Argument_List)
- return Integer
+ Args : Argument_List) return Integer
is
Junk : Process_Id;
Result : Integer;
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;
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;
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
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.
(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).
-- 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.
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
-- 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);
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;
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;
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);
------------------------
procedure Store_File_Context is
+ use type System.CRTL.long;
begin
RB_Next_Line := Next_Line;
RB_Nfirst := Nfirst;
-- --
-- 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- --
package body Interfaces.C_Streams is
+ use type System.CRTL.size_t;
+
------------
-- fread --
------------
-- 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
-- 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;
(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;
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;
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 --
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");
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- --
-- 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- --
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;
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 --
-----------------------
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;
package SSL renames System.Soft_Links;
+ use type System.CRTL.size_t;
+
----------------------
-- Global Variables --
----------------------
-- --
-- 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 --
-- --
------------------------------------------------------------------------------
--- 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
-- 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).
-- 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;
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 --
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;
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;
-- --
-- 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- --
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
procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
pragma Warnings (Off, Any_Stack);
-
begin
Cache := Null_Stack;
end Invalidate_Stack_Cache;
--------------------
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;
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.
-- 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;
-----------------
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;
-- 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
-- --
-- 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- --
-- 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
-- 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.
procedure Put (S : String) is
begin
- write (2, S, S'Length);
+ Write (2, S, S'Length);
end Put;
--------------
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;
----------------------
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;
OSDN Git Service
