From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,ed872c72866dab2b
X-Google-NewGroupId: yes
X-Google-Attributes: gida07f3367d7,domainid0,public,usenet
X-Google-Language: ENGLISH,ASCII-7-bit
Path: 
 g2news2.google.com!news3.google.com!feeder.news-service.com!newsfeed.straub-nv.de!noris.net!newsfeed.arcor.de!newsspool4.arcor-online.net!news.arcor.de.POSTED!not-for-mail
Date: Thu, 16 Jun 2011 23:14:55 +0200
From: Georg Bauhaus <rm.dash-bauhaus@futureapps.de>
User-Agent: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US;
 rv:1.9.2.18) Gecko/20110613 Thunderbird/3.1.11
MIME-Version: 1.0
Newsgroups: comp.lang.ada
Subject: Re: expression function bug or think?
References: 
 <678085105329914667.504682rmhost.bauhaus-maps.arcor.de@news.arcor.de>
	<87wrglwmao.fsf@mid.deneb.enyo.de> <m2tybp1pce.fsf@pushface.org>
In-Reply-To: <m2tybp1pce.fsf@pushface.org>
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
Content-Transfer-Encoding: 7bit
Message-ID: <4dfa7250$0$7610$9b4e6d93@newsspool1.arcor-online.net>
Organization: Arcor
NNTP-Posting-Date: 16 Jun 2011 23:14:56 CEST
NNTP-Posting-Host: ad9ca4ba.newsspool1.arcor-online.net
X-Trace: 
 DXC=e7BDPk^jO]?gP]QSEBQ^d4ic==]BZ:af>4Fo<]lROoR1<`=YMgDjhg2[lUC1AFhcn3nc\616M64>:Lh>_cHTX3j=]GAL:KLHlk:
X-Complaints-To: usenet-abuse@arcor.de
Xref: g2news2.google.com comp.lang.ada:20864
Date: 2011-06-16T23:14:56+02:00
List-Id: <comp.lang.ada>

On 6/16/11 10:41 PM, Simon Wright wrote:
> Florian Weimer<fw@deneb.enyo.de>  writes:
>
>> Out of curiosity, can you show us the expanded Ada code, using -gnatG?
>
> GNAT GPL 2011, with -gnatp:
>
> functions_E : short_integer := 0;
>
> package functions is
>     function functions__fib (n : natural) return natural;
>
>     function functions__fib (n : natural) return natural is
>     begin
>        return
>           do
>              T2s : natural;
>              case n is
>                 when 0 =>
>                    T2s := 0;

>     function functions__fib (n : natural) return natural is
>     begin
>        return
>           do
>              T2s : natural;[constraint_error when
>                not (n - 1>= 0)
>                "range check failed"][constraint_error when

> Pretty conclusive, I think!


This seems to confirm what I have found in the assembly listing.
(The very first call in Run_Fib with N = 0 raises Constraint_Error.)
The case expression seems to cause the effect.

For comparison, a case statement in a function body (see below)
does not generate a "subtract 1" instruction (which at least
matches the not (n - 1>= 0) shown above).

Assembly for _functions__fib, assume called with N = 0:

         movl    %edi, -20(%rbp)
         movl    -20(%rbp), %eax    ; N in EAX
         subl    $1, %eax          ; -1   <-----------------
         testl   %eax, %eax        ;  sets sign flag  SF
         jns     L2                ; jump if SF not set
         leaq    LC0(%rip), %rax   ;  range check otherwise ...
         movl    $6, %esi
         movq    %rax, %rdi
         call    ___gnat_rcheck_12

Assembly for function with case statement:

         movl    %edi, -20(%rbp)
         movl    -20(%rbp), %eax
                                   ; no SUB here, no -1
         testl   %eax, %eax
         jns     L13
         leaq    LC0(%rip), %rax
         movl    $26, %esi
         movq    %rax, %rdi
         call    ___gnat_rcheck_06


package Functions is
function Fib (N : Natural) return Natural is
     (case N is
      when 0 => 0,
      when 1 => 1,
      when others => Fib(N-1) + Fib(N-2));
function Fib2 (N : Natural) return Natural;
end Functions;

with Functions;
with Ada.Text_IO;

procedure Run_Fib is
     N : Natural;
begin
     if Functions.Fib2(0) /= 0 then
          raise Program_Error;
     end if;
--    N := Functions.Fib(10);
--    Ada.Text_IO.Put_Line ("fib(10) =" & Natural'Image(N));
end Run_Fib;

package body Functions is
function Fib2 (N : Natural) return Natural is
begin
     case N is
     when 0 => return 0;
     when 1 => return 1;
     when others => return Fib2(N-1) + Fib2(N-2);
     end case;
end Fib2;
end Functions;