diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/g-dirope.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/gnatchop.adb | 32 | ||||
| -rw-r--r-- | gcc/ada/gnatlbr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/mlib-tgt-vms-ia64.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/s-crtl.ads | 20 |
5 files changed, 55 insertions, 29 deletions
diff --git a/gcc/ada/g-dirope.adb b/gcc/ada/g-dirope.adb index 40a181a7087..6c46baa86b4 100644 --- a/gcc/ada/g-dirope.adb +++ b/gcc/ada/g-dirope.adb @@ -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 diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 0c5a25227af..a6b12e5c5fa 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -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; diff --git a/gcc/ada/gnatlbr.adb b/gcc/ada/gnatlbr.adb index 3dd2d4dba29..6873c3cc5f2 100644 --- a/gcc/ada/gnatlbr.adb +++ b/gcc/ada/gnatlbr.adb @@ -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 diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index cad8ae1401b..e921566473c 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -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 -- diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index 9fef16b4f24..42bdf02c73e 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -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; |