FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

gnatchop.adb (dup, [...]): Reference via System.CRTL.

Browse source 
2005-02-09  Doug Rupp  <rupp@adacore.com>

	* gnatchop.adb (dup, dup2),
	g-dirope.adb (closedir, opendir, rmdir): Reference via System.CRTL.

	* gnatlbr.adb (mkdir),
	mlib-tgt-vms-ia64.adb (popen, plose):  Import with decc$ prefix.

	* s-crtl.ads (closdir, dup, dup2, opendir, rmdir): Import.

From-SVN: r94807
This commit is contained in:
Doug Rupp 2005-02-10 14:49:15 +01:00 • committed by Arnaud Charlet
parent edc7394cad
commit 70ad376e2f
5 changed files with 55 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
gcc/ada/g-dirope.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 1998-2005 Ada Core Technologies, 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,9 +34,12 @@
with Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Unchecked_Deallocation;
with Unchecked_Conversion;
with System; use System;
with System; use System;
with System.CRTL; use System.CRTL;
with GNAT.OS_Lib;
@ -181,10 +184,6 @@ package body GNAT.Directory_Operations is
-----------
procedure Close (Dir : in out Dir_Type) is
function closedir (Directory : System.Address) return Integer;
pragma Import (C, closedir, "closedir");
Discard : Integer;
pragma Warnings (Off, Discard);
@ -193,7 +192,7 @@ package body GNAT.Directory_Operations is
raise Directory_Error;
end if;
Discard := closedir (System.Address (Dir.all));
Discard := closedir (DIRs (Dir.all));
Free (Dir);
end Close;
@ -630,12 +629,8 @@ package body GNAT.Directory_Operations is
is
C_File_Name : constant String := Dir_Name & ASCII.NUL;
function opendir
(File_Name : String) return Dir_Type_Value;
pragma Import (C, opendir, "opendir");
begin
Dir := new Dir_Type_Value'(opendir (C_File_Name));
Dir := new Dir_Type_Value'(Dir_Type_Value (opendir (C_File_Name)));
if not Is_Open (Dir) then
Free (Dir);
@ -737,9 +732,6 @@ package body GNAT.Directory_Operations is
Success : Boolean;
Working_Dir : Dir_Type;
procedure rmdir (Dir_Name : String);
pragma Import (C, rmdir, "rmdir");
begin
-- Remove the directory only if it is empty

32
gcc/ada/gnatchop.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2004 Ada Core Technologies, Inc. --
-- Copyright (C) 1998-2005 Ada Core Technologies, 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- --
@ -35,6 +35,8 @@ with GNAT.Table;
with Gnatvsn;
with Hostparm;
with System.CRTL; use System.CRTL;
procedure Gnatchop is
Terminate_Program : exception;
@ -182,7 +184,7 @@ procedure Gnatchop is
-- Note that this function returns false for the last entry.
procedure Sort_Units;
-- Sort units and set up sorted unit table.
-- Sort units and set up sorted unit table
----------------------
-- File_Descriptors --
@ -190,10 +192,6 @@ procedure Gnatchop is
function dup (handle : File_Descriptor) return File_Descriptor;
function dup2 (from, to : File_Descriptor) return File_Descriptor;
-- File descriptor based functions needed for redirecting stdin/stdout
pragma Import (C, dup, "dup");
pragma Import (C, dup2, "dup2");
---------------------
-- Local variables --
@ -332,6 +330,24 @@ procedure Gnatchop is
Success : out Boolean);
-- Write one compilation unit of the source to file
---------
-- dup --
---------
function dup (handle : File_Descriptor) return File_Descriptor is
begin
return File_Descriptor (System.CRTL.dup (int (handle)));
end dup;
----------
-- dup2 --
----------
function dup2 (from, to : File_Descriptor) return File_Descriptor is
begin
return File_Descriptor (System.CRTL.dup2 (int (from), int (to)));
end dup2;
---------------
-- Error_Msg --
---------------
@ -1148,7 +1164,7 @@ procedure Gnatchop is
Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line
(Standard_Error,
"Copyright 1998-2004, Ada Core Technologies Inc.");
"Copyright 1998-2005, Ada Core Technologies Inc.");
when 'w' =>
Overwrite_Files := True;
@ -1316,7 +1332,7 @@ procedure Gnatchop is
Unit_Sort.Sort (Natural (Unit.Last));
-- Set the Sorted_Index fields in the unit tables.
-- Set the Sorted_Index fields in the unit tables
for J in 1 .. SUnit_Num (Unit.Last) loop
Unit.Table (Sorted_Units.Table (J)).Sorted_Index := J;

4
gcc/ada/gnatlbr.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2004 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2005 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- --
@ -61,7 +61,7 @@ procedure GnatLbr is
Make_Path : String_Access;
procedure Create_Directory (Name : System.Address; Mode : Integer);
pragma Import (C, Create_Directory, "mkdir");
pragma Import (C, Create_Directory, "decc$mkdir");
begin
if Argument_Count = 0 then

6
gcc/ada/mlib-tgt-vms-ia64.adb
View file

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2005 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- --
@ -77,10 +77,10 @@ package body MLib.Tgt is
------------------------------
function Popen (Command, Mode : System.Address) return System.Address;
pragma Import (C, Popen);
pragma Import (C, Popen, "decc$popen");
function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose);
pragma Import (C, Pclose, "decc$pclose");
---------------------
-- Archive_Builder --

20
gcc/ada/s-crtl.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- Copyright (C) 2003-2005 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- --
@ -41,6 +41,9 @@ pragma Preelaborate (CRTL);
subtype chars is System.Address;
-- Pointer to null-terminated array of characters
subtype DIRs is System.Address;
-- Corresponds to the C type DIR*
subtype FILEs is System.Address;
-- Corresponds to the C type FILE*
@ -59,6 +62,15 @@ pragma Preelaborate (CRTL);
procedure clearerr (stream : FILEs);
pragma Import (C, clearerr, "clearerr");
function closedir (directory : DIRs) return Integer;
pragma Import (C, closedir, "closedir");
function dup (handle : int) return int;
pragma Import (C, dup, "dup");
function dup2 (from, to : int) return int;
pragma Import (C, dup2, "dup2");
function fclose (stream : FILEs) return int;
pragma Import (C, fclose, "fclose");
@ -124,6 +136,9 @@ pragma Preelaborate (CRTL);
procedure mktemp (template : chars);
pragma Import (C, mktemp, "mktemp");
function opendir (file_name : String) return DIRs;
pragma Import (C, opendir, "opendir");
function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read");
@ -134,6 +149,9 @@ pragma Preelaborate (CRTL);
procedure rewind (stream : FILEs);
pragma Import (C, rewind, "rewind");
procedure rmdir (dir_name : String);
pragma Import (C, rmdir, "rmdir");
function setvbuf
(stream : FILEs;
buffer : chars;