gnatchop.adb (dup, [...]): Reference via System.CRTL.
authorDoug Rupp <rupp@adacore.com>
Thu, 10 Feb 2005 13:49:15 +0000 (14:49 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 10 Feb 2005 13:49:15 +0000 (14:49 +0100)
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

gcc/ada/g-dirope.adb
gcc/ada/gnatchop.adb
gcc/ada/gnatlbr.adb
gcc/ada/mlib-tgt-vms-ia64.adb
gcc/ada/s-crtl.ads

index 40a181a708793d3ad19870c625c0c35bbc1956e8..6c46baa86b4473759b5e7b82b457b28228ef1578 100644 (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- --
 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
 
index 0c5a25227af824d78bd9260594142989382573c9..a6b12e5c5fa8b7de0fa8137886ac87df423bfc0b 100644 (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;
index 3dd2d4dba2942af7821dc9c601ee3d6d448424d8..6873c3cc5f2a28a717773208f817881c47e8c664 100644 (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
index cad8ae1401b4281e8a23ce72bfcaa5fa9e01a8b2..e921566473c3c88eb31d6e1935a063310bccdb10 100644 (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 --
index 9fef16b4f24357122f4836b33030f1ad8b051b06..42bdf02c73e3ba6d1c62637e67a6a74424ebab26 100644 (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;