OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [dnrm2.f] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
c { dg-do run }
2
c { dg-options "-fno-bounds-check" }
3
CCC g77 0.5.21 `Actual Bugs':
4
CCC   * A code-generation bug afflicts Intel x86 targets when `-O2' is
5
CCC     specified compiling, for example, an old version of the `DNRM2'
6
CCC     routine.  The x87 coprocessor stack is being somewhat mismanaged
7
CCC     in cases where assigned `GOTO' and `ASSIGN' are involved.
8
CCC
9
CCC     Version 0.5.21 of `g77' contains an initial effort to fix the
10
CCC     problem, but this effort is incomplete, and a more complete fix is
11
CCC     planned for the next release.
12
 
13
C     Currently this test fails with (at least) `-O2 -funroll-loops' on
14
C     i586-unknown-linux-gnulibc1.
15
 
16
C     (This is actually an obsolete version of dnrm2 -- consult the
17
c     current Netlib BLAS.)
18
 
19
      integer i
20
      double precision a(1:100), dnrm2
21
      do i=1,100
22
         a(i)=0.D0
23
      enddo
24
      if (dnrm2(100,a,1) .ne. 0.0) call abort
25
      end
26
 
27
      double precision function dnrm2 ( n, dx, incx)
28
      integer i, incx, ix, j, n, next
29
      double precision   dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
30
      data   zero, one /0.0d0, 1.0d0/
31
      data cutlo, cuthi / 8.232d-11,  1.304d19 /
32
      j = 0
33
      if(n .gt. 0 .and. incx.gt.0) go to 10
34
         dnrm2  = zero
35
         go to 300
36
   10 assign 30 to next ! { dg-warning "ASSIGN" "" }
37
      sum = zero
38
      i = 1
39
      ix = 1
40
   20    go to next,(30, 50, 70, 110) ! { dg-warning "Assigned GOTO" "" }
41
   30 if( dabs(dx(i)) .gt. cutlo) go to 85
42
      assign 50 to next ! { dg-warning "ASSIGN" "" }
43
      xmax = zero
44
   50 if( dx(i) .eq. zero) go to 200
45
      if( dabs(dx(i)) .gt. cutlo) go to 85
46
      assign 70 to next ! { dg-warning "ASSIGN" "" }
47
      go to 105
48
  100 continue
49
      ix = j
50
      assign 110 to next ! { dg-warning "ASSIGN" "" }
51
      sum = (sum / dx(i)) / dx(i)
52
  105 xmax = dabs(dx(i))
53
      go to 115
54
   70 if( dabs(dx(i)) .gt. cutlo ) go to 75
55
  110 if( dabs(dx(i)) .le. xmax ) go to 115
56
         sum = one + sum * (xmax / dx(i))**2
57
         xmax = dabs(dx(i))
58
         go to 200
59
  115 sum = sum + (dx(i)/xmax)**2
60
      go to 200
61
   75 sum = (sum * xmax) * xmax
62
   85 hitest = cuthi/float( n )
63
      do 95 j = ix,n
64
      if(dabs(dx(i)) .ge. hitest) go to 100
65
         sum = sum + dx(i)**2
66
         i = i + incx
67
   95 continue
68
      dnrm2 = dsqrt( sum )
69
      go to 300
70
  200 continue
71
      ix = ix + 1
72
      i = i + incx
73
      if( ix .le. n ) go to 20
74
      dnrm2 = xmax * dsqrt(sum)
75
  300 continue
76
      end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.