From patchwork Fri Nov 15 11:52:48 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: "H.J. Lu" X-Patchwork-Id: 291549 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (Client did not present a certificate) by ozlabs.org (Postfix) with ESMTPS id BCCC52C00C3 for ; Fri, 15 Nov 2013 22:53:10 +1100 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:in-reply-to:references:date:message-id:subject :from:to:cc:content-type; q=dns; s=default; b=yJQL30JpStxkcPC5tN bI6N6QosBC/SjfT16VrfvgU3rwCJEOoZYNr85qFNdypmDRfOn2SAVHZ9z621zrTb 3H9Oj2lWgYlK9dQJ5q7hIHe95XsnXUh5UFsD6F6GpdVCzPUNkOUQdAzdm7L+K9O+ APIaTtiAcBHpwswRCvrK/G5Xo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:in-reply-to:references:date:message-id:subject :from:to:cc:content-type; s=default; bh=6kTAmReOiOsSk9gkCes7jccE lrI=; b=Aa8YlHTPxqBv0vZl8zqyEDZrb0L9TfcSz2uVjaWSsP/f1uyD3b9UDB2N bKMIURAR8TqFD/8Z+rCexFAem2lx5SyRaXhkZKWgbCb3Yqb4feChCNqLK2IH0f8F 05uOAGWHD2Ld2NVyjgkGVOAeET7zmJqktZcunViVHQTY6po+hoA= Received: (qmail 31125 invoked by alias); 15 Nov 2013 11:53:00 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 31112 invoked by uid 89); 15 Nov 2013 11:52:58 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=2.2 required=5.0 tests=AWL, BAYES_99, FREEMAIL_FROM, RDNS_NONE, SPF_PASS, URIBL_BLOCKED autolearn=no version=3.3.2 X-HELO: mail-ob0-f180.google.com Received: from Unknown (HELO mail-ob0-f180.google.com) (209.85.214.180) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Fri, 15 Nov 2013 11:52:56 +0000 Received: by mail-ob0-f180.google.com with SMTP id vb8so3730614obc.11 for ; Fri, 15 Nov 2013 03:52:49 -0800 (PST) MIME-Version: 1.0 X-Received: by 10.182.246.39 with SMTP id xt7mr6553802obc.16.1384516368993; Fri, 15 Nov 2013 03:52:48 -0800 (PST) Received: by 10.76.83.233 with HTTP; Fri, 15 Nov 2013 03:52:48 -0800 (PST) In-Reply-To: <20131115113815.GB7411@adacore.com> References: <20131114141639.GA5675@adacore.com> <20131115101126.GA11383@adacore.com> <20131115105054.GC15490@adacore.com> <20131115111843.GA31367@adacore.com> <20131115113815.GB7411@adacore.com> Date: Fri, 15 Nov 2013 03:52:48 -0800 Message-ID: Subject: Re: [PATCH] PR ada/54040: [x32] Incorrect timeval and timespec From: "H.J. Lu" To: Arnaud Charlet Cc: GCC Patches , Eric Botcazou X-IsSubscribed: yes On Fri, Nov 15, 2013 at 3:38 AM, Arnaud Charlet wrote: >> > Looks better now, but please do not add a dependency on System.Linux in >> > s-taprop-linux.adb, and instead use: >> > >> > type timeval is array (1 .. 2) of System.OS_Interface.time_t; >> > >> > Arno >> >> It doesn't work: >> >> s-taprop.adb:630:60: "time_t" is not a visible entity of "OS_Interface" > > Right, time_t is private in s-osinte-linux.ads, so you need to add: > > --- s-osinte-linux.ads (revision 298854) > +++ s-osinte-linux.ads (working copy) > @@ -218,6 +218,7 @@ > ---------- > > type timespec is private; > + type time_t is private; > > function To_Duration (TS : timespec) return Duration; > pragma Inline (To_Duration); > > To make it visible. Here is the new patch. Does it look OK? Thanks. diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 91778c5..885a5ed 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -2186,11 +2186,11 @@ ifeq ($(strip $(filter-out %x32 linux%,$(target_cpu) $(target_os))),) a-synbar.ads. -- +-- -- +-- -- +------------------------------------------------------------------------------ + +-- This is the x32 version of this package + +-- This package encapsulates cpu specific differences between implementations +-- of GNU/Linux, in order to share s-osinte-linux.ads. + +-- PLEASE DO NOT add any with-clauses to this package or remove the pragma +-- Preelaborate. This package is designed to be a bottom-level (leaf) package + +package System.Linux is + pragma Preelaborate; + + ------------ + -- time_t -- + ------------ + + type time_t is new Long_Long_Integer; + + ----------- + -- Errno -- + ----------- + + EAGAIN : constant := 11; + EINTR : constant := 4; + EINVAL : constant := 22; + ENOMEM : constant := 12; + EPERM : constant := 1; + ETIMEDOUT : constant := 110; + + ------------- + -- Signals -- + ------------- + + SIGHUP : constant := 1; -- hangup + SIGINT : constant := 2; -- interrupt (rubout) + SIGQUIT : constant := 3; -- quit (ASCD FS) + SIGILL : constant := 4; -- illegal instruction (not reset) + SIGTRAP : constant := 5; -- trace trap (not reset) + SIGIOT : constant := 6; -- IOT instruction + SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future + SIGFPE : constant := 8; -- floating point exception + SIGKILL : constant := 9; -- kill (cannot be caught or ignored) + SIGBUS : constant := 7; -- bus error + SIGSEGV : constant := 11; -- segmentation violation + SIGPIPE : constant := 13; -- write on a pipe with no one to read it + SIGALRM : constant := 14; -- alarm clock + SIGTERM : constant := 15; -- software termination signal from kill + SIGUSR1 : constant := 10; -- user defined signal 1 + SIGUSR2 : constant := 12; -- user defined signal 2 + SIGCLD : constant := 17; -- alias for SIGCHLD + SIGCHLD : constant := 17; -- child status change + SIGPWR : constant := 30; -- power-fail restart + SIGWINCH : constant := 28; -- window size change + SIGURG : constant := 23; -- urgent condition on IO channel + SIGPOLL : constant := 29; -- pollable event occurred + SIGIO : constant := 29; -- I/O now possible (4.2 BSD) + SIGLOST : constant := 29; -- File lock lost + SIGSTOP : constant := 19; -- stop (cannot be caught or ignored) + SIGTSTP : constant := 20; -- user stop requested from tty + SIGCONT : constant := 18; -- stopped process has been continued + SIGTTIN : constant := 21; -- background tty read attempted + SIGTTOU : constant := 22; -- background tty write attempted + SIGVTALRM : constant := 26; -- virtual timer expired + SIGPROF : constant := 27; -- profiling timer expired + SIGXCPU : constant := 24; -- CPU time limit exceeded + SIGXFSZ : constant := 25; -- filesize limit exceeded + SIGUNUSED : constant := 31; -- unused signal (GNU/Linux) + SIGSTKFLT : constant := 16; -- coprocessor stack fault (Linux) + SIGLTHRRES : constant := 32; -- GNU/LinuxThreads restart signal + SIGLTHRCAN : constant := 33; -- GNU/LinuxThreads cancel signal + SIGLTHRDBG : constant := 34; -- GNU/LinuxThreads debugger signal + + -- struct_sigaction offsets + + sa_handler_pos : constant := 0; + sa_mask_pos : constant := Standard'Address_Size / 8; + sa_flags_pos : constant := 128 + sa_mask_pos; + + SA_SIGINFO : constant := 16#04#; + SA_ONSTACK : constant := 16#08000000#; + +end System.Linux; diff --git a/gcc/ada/s-linux.ads b/gcc/ada/s-linux.ads index c8a7ad1..2339e29 100644 --- a/gcc/ada/s-linux.ads +++ b/gcc/ada/s-linux.ads @@ -38,6 +38,12 @@ package System.Linux is pragma Preelaborate; + ------------ + -- time_t -- + ------------ + + type time_t is new Long_Integer; + ----------- -- Errno -- ----------- diff --git a/gcc/ada/s-osinte-linux.ads b/gcc/ada/s-osinte-linux.ads index a99c4e5..6eb0b88 100644 --- a/gcc/ada/s-osinte-linux.ads +++ b/gcc/ada/s-osinte-linux.ads @@ -218,6 +218,7 @@ package System.OS_Interface is ---------- type timespec is private; + type time_t is private; function To_Duration (TS : timespec) return Duration; pragma Inline (To_Duration); @@ -596,11 +597,11 @@ private type pid_t is new int; - type time_t is new long; + type time_t is new System.Linux.time_t; type timespec is record tv_sec : time_t; - tv_nsec : long; + tv_nsec : time_t; end record; pragma Convention (C, timespec); diff --git a/gcc/ada/s-osinte-posix.adb b/gcc/ada/s-osinte-posix.adb index 29579b2..402ddcb 100644 --- a/gcc/ada/s-osinte-posix.adb +++ b/gcc/ada/s-osinte-posix.adb @@ -104,7 +104,7 @@ package body System.OS_Interface is end if; return timespec'(tv_sec => S, - tv_nsec => long (Long_Long_Integer (F * 10#1#E9))); + tv_nsec => time_t (Long_Long_Integer (F * 10#1#E9))); end To_Timespec; end System.OS_Interface; diff --git a/gcc/ada/s-osprim-x32.adb b/gcc/ada/s-osprim-x32.adb new file mode 100644 index 0000000..5d4964a --- /dev/null +++ b/gcc/ada/s-osprim-x32.adb @@ -0,0 +1,173 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ P R I M I T I V E S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2013, 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- -- +-- ware Foundation; either version 3, 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. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for Linux/x32 + +package body System.OS_Primitives is + + -- ??? These definitions are duplicated from System.OS_Interface + -- because we don't want to depend on any package. Consider removing + -- these declarations in System.OS_Interface and move these ones in + -- the spec. + + type time_t is new Long_Long_Integer; + + type timespec is record + tv_sec : time_t; + tv_nsec : time_t; + end record; + pragma Convention (C, timespec); + + function nanosleep (rqtp, rmtp : not null access timespec) return Integer; + pragma Import (C, nanosleep, "nanosleep"); + + ----------- + -- Clock -- + ----------- + + function Clock return Duration is + type timeval is array (1 .. 2) of time_t; + + procedure timeval_to_duration + (T : not null access timeval; + sec : not null access Long_Integer; + usec : not null access Long_Integer); + pragma Import (C, timeval_to_duration, "__gnat_timeval_to_duration"); + + Micro : constant := 10**6; + sec : aliased Long_Integer; + usec : aliased Long_Integer; + TV : aliased timeval; + Result : Integer; + pragma Unreferenced (Result); + + function gettimeofday + (Tv : access timeval; + Tz : System.Address := System.Null_Address) return Integer; + pragma Import (C, gettimeofday, "gettimeofday"); + + begin + -- The return codes for gettimeofday are as follows (from man pages): + -- EPERM settimeofday is called by someone other than the superuser + -- EINVAL Timezone (or something else) is invalid + -- EFAULT One of tv or tz pointed outside accessible address space + + -- None of these codes signal a potential clock skew, hence the return + -- value is never checked. + + Result := gettimeofday (TV'Access, System.Null_Address); + timeval_to_duration (TV'Access, sec'Access, usec'Access); + return Duration (sec) + Duration (usec) / Micro; + end Clock; + + --------------------- + -- Monotonic_Clock -- + --------------------- + + function Monotonic_Clock return Duration renames Clock; + + ----------------- + -- To_Timespec -- + ----------------- + + function To_Timespec (D : Duration) return timespec; + + function To_Timespec (D : Duration) return timespec is + S : time_t; + F : Duration; + + begin + S := time_t (Long_Long_Integer (D)); + F := D - Duration (S); + + -- If F has negative value due to a round-up, adjust for positive F + -- value. + + if F < 0.0 then + S := S - 1; + F := F + 1.0; + end if; + + return + timespec'(tv_sec => S, + tv_nsec => time_t (Long_Long_Integer (F * 10#1#E9))); + end To_Timespec; + + ----------------- + -- Timed_Delay -- + ----------------- + + procedure Timed_Delay + (Time : Duration; + Mode : Integer) + is + Request : aliased timespec; + Remaind : aliased timespec; + Rel_Time : Duration; + Abs_Time : Duration; + Base_Time : constant Duration := Clock; + Check_Time : Duration := Base_Time; + + Result : Integer; + pragma Unreferenced (Result); + + begin + if Mode = Relative then + Rel_Time := Time; + Abs_Time := Time + Check_Time; + else + Rel_Time := Time - Check_Time; + Abs_Time := Time; + end if; + + if Rel_Time > 0.0 then + loop + Request := To_Timespec (Rel_Time); + Result := nanosleep (Request'Access, Remaind'Access); + Check_Time := Clock; + + exit when Abs_Time <= Check_Time or else Check_Time < Base_Time; + + Rel_Time := Abs_Time - Check_Time; + end loop; + end if; + end Timed_Delay; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize is + begin + null; + end Initialize; + +end System.OS_Primitives; diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb index 6047d31..b8accbec 100644 --- a/gcc/ada/s-taprop-linux.adb +++ b/gcc/ada/s-taprop-linux.adb @@ -627,7 +627,7 @@ package body System.Task_Primitives.Operations is function Monotonic_Clock return Duration is use Interfaces; - type timeval is array (1 .. 2) of C.long; + type timeval is array (1 .. 2) of System.OS_Interface.time_t; procedure timeval_to_duration (T : not null access timeval;