Commit 70ad376e by Doug Rupp Committed by Arnaud Charlet

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

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
parent edc7394c
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -34,9 +34,12 @@ ...@@ -34,9 +34,12 @@
with Ada.Characters.Handling; with Ada.Characters.Handling;
with Ada.Strings.Fixed; with Ada.Strings.Fixed;
with Ada.Strings.Maps; with Ada.Strings.Maps;
with Unchecked_Deallocation; with Unchecked_Deallocation;
with Unchecked_Conversion; with Unchecked_Conversion;
with System; use System;
with System; use System;
with System.CRTL; use System.CRTL;
with GNAT.OS_Lib; with GNAT.OS_Lib;
...@@ -181,10 +184,6 @@ package body GNAT.Directory_Operations is ...@@ -181,10 +184,6 @@ package body GNAT.Directory_Operations is
----------- -----------
procedure Close (Dir : in out Dir_Type) is procedure Close (Dir : in out Dir_Type) is
function closedir (Directory : System.Address) return Integer;
pragma Import (C, closedir, "closedir");
Discard : Integer; Discard : Integer;
pragma Warnings (Off, Discard); pragma Warnings (Off, Discard);
...@@ -193,7 +192,7 @@ package body GNAT.Directory_Operations is ...@@ -193,7 +192,7 @@ package body GNAT.Directory_Operations is
raise Directory_Error; raise Directory_Error;
end if; end if;
Discard := closedir (System.Address (Dir.all)); Discard := closedir (DIRs (Dir.all));
Free (Dir); Free (Dir);
end Close; end Close;
...@@ -630,12 +629,8 @@ package body GNAT.Directory_Operations is ...@@ -630,12 +629,8 @@ package body GNAT.Directory_Operations is
is is
C_File_Name : constant String := Dir_Name & ASCII.NUL; C_File_Name : constant String := Dir_Name & ASCII.NUL;
function opendir
(File_Name : String) return Dir_Type_Value;
pragma Import (C, opendir, "opendir");
begin 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 if not Is_Open (Dir) then
Free (Dir); Free (Dir);
...@@ -737,9 +732,6 @@ package body GNAT.Directory_Operations is ...@@ -737,9 +732,6 @@ package body GNAT.Directory_Operations is
Success : Boolean; Success : Boolean;
Working_Dir : Dir_Type; Working_Dir : Dir_Type;
procedure rmdir (Dir_Name : String);
pragma Import (C, rmdir, "rmdir");
begin begin
-- Remove the directory only if it is empty -- Remove the directory only if it is empty
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -35,6 +35,8 @@ with GNAT.Table; ...@@ -35,6 +35,8 @@ with GNAT.Table;
with Gnatvsn; with Gnatvsn;
with Hostparm; with Hostparm;
with System.CRTL; use System.CRTL;
procedure Gnatchop is procedure Gnatchop is
Terminate_Program : exception; Terminate_Program : exception;
...@@ -182,7 +184,7 @@ procedure Gnatchop is ...@@ -182,7 +184,7 @@ procedure Gnatchop is
-- Note that this function returns false for the last entry. -- Note that this function returns false for the last entry.
procedure Sort_Units; procedure Sort_Units;
-- Sort units and set up sorted unit table. -- Sort units and set up sorted unit table
---------------------- ----------------------
-- File_Descriptors -- -- File_Descriptors --
...@@ -190,10 +192,6 @@ procedure Gnatchop is ...@@ -190,10 +192,6 @@ procedure Gnatchop is
function dup (handle : File_Descriptor) return File_Descriptor; function dup (handle : File_Descriptor) return File_Descriptor;
function dup2 (from, to : 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 -- -- Local variables --
...@@ -332,6 +330,24 @@ procedure Gnatchop is ...@@ -332,6 +330,24 @@ procedure Gnatchop is
Success : out Boolean); Success : out Boolean);
-- Write one compilation unit of the source to file -- 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 -- -- Error_Msg --
--------------- ---------------
...@@ -1148,7 +1164,7 @@ procedure Gnatchop is ...@@ -1148,7 +1164,7 @@ procedure Gnatchop is
Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String); Put_Line (Standard_Error, Gnatvsn.Gnat_Version_String);
Put_Line Put_Line
(Standard_Error, (Standard_Error,
"Copyright 1998-2004, Ada Core Technologies Inc."); "Copyright 1998-2005, Ada Core Technologies Inc.");
when 'w' => when 'w' =>
Overwrite_Files := True; Overwrite_Files := True;
...@@ -1316,7 +1332,7 @@ procedure Gnatchop is ...@@ -1316,7 +1332,7 @@ procedure Gnatchop is
Unit_Sort.Sort (Natural (Unit.Last)); 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 for J in 1 .. SUnit_Num (Unit.Last) loop
Unit.Table (Sorted_Units.Table (J)).Sorted_Index := J; Unit.Table (Sorted_Units.Table (J)).Sorted_Index := J;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -61,7 +61,7 @@ procedure GnatLbr is ...@@ -61,7 +61,7 @@ procedure GnatLbr is
Make_Path : String_Access; Make_Path : String_Access;
procedure Create_Directory (Name : System.Address; Mode : Integer); procedure Create_Directory (Name : System.Address; Mode : Integer);
pragma Import (C, Create_Directory, "mkdir"); pragma Import (C, Create_Directory, "decc$mkdir");
begin begin
if Argument_Count = 0 then if Argument_Count = 0 then
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -77,10 +77,10 @@ package body MLib.Tgt is ...@@ -77,10 +77,10 @@ package body MLib.Tgt is
------------------------------ ------------------------------
function Popen (Command, Mode : System.Address) return System.Address; 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; function Pclose (File : System.Address) return Integer;
pragma Import (C, Pclose); pragma Import (C, Pclose, "decc$pclose");
--------------------- ---------------------
-- Archive_Builder -- -- Archive_Builder --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -41,6 +41,9 @@ pragma Preelaborate (CRTL); ...@@ -41,6 +41,9 @@ pragma Preelaborate (CRTL);
subtype chars is System.Address; subtype chars is System.Address;
-- Pointer to null-terminated array of characters -- Pointer to null-terminated array of characters
subtype DIRs is System.Address;
-- Corresponds to the C type DIR*
subtype FILEs is System.Address; subtype FILEs is System.Address;
-- Corresponds to the C type FILE* -- Corresponds to the C type FILE*
...@@ -59,6 +62,15 @@ pragma Preelaborate (CRTL); ...@@ -59,6 +62,15 @@ pragma Preelaborate (CRTL);
procedure clearerr (stream : FILEs); procedure clearerr (stream : FILEs);
pragma Import (C, clearerr, "clearerr"); 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; function fclose (stream : FILEs) return int;
pragma Import (C, fclose, "fclose"); pragma Import (C, fclose, "fclose");
...@@ -124,6 +136,9 @@ pragma Preelaborate (CRTL); ...@@ -124,6 +136,9 @@ pragma Preelaborate (CRTL);
procedure mktemp (template : chars); procedure mktemp (template : chars);
pragma Import (C, mktemp, "mktemp"); 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; function read (fd : int; buffer : chars; nbytes : int) return int;
pragma Import (C, read, "read"); pragma Import (C, read, "read");
...@@ -134,6 +149,9 @@ pragma Preelaborate (CRTL); ...@@ -134,6 +149,9 @@ pragma Preelaborate (CRTL);
procedure rewind (stream : FILEs); procedure rewind (stream : FILEs);
pragma Import (C, rewind, "rewind"); pragma Import (C, rewind, "rewind");
procedure rmdir (dir_name : String);
pragma Import (C, rmdir, "rmdir");
function setvbuf function setvbuf
(stream : FILEs; (stream : FILEs;
buffer : chars; buffer : chars;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment