diff options
| author | dnovillo <dnovillo@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-13 06:41:07 +0000 |
|---|---|---|
| committer | dnovillo <dnovillo@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-13 06:41:07 +0000 |
| commit | 4ee9c6840ad3fc92a9034343278a1e476ad6872a (patch) | |
| tree | a2568888a519c077427b133de9ece5879a8484a5 /libgfortran/generated | |
| parent | ebb338380ab170c91e64d38038e6b5ce930d69a1 (diff) | |
| download | gcc-4ee9c6840ad3fc92a9034343278a1e476ad6872a.tar.gz | |
Merge tree-ssa-20020619-branch into mainline.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81764 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran/generated')
168 files changed, 20530 insertions, 0 deletions
diff --git a/libgfortran/generated/_abs_c4.f90 b/libgfortran/generated/_abs_c4.f90 new file mode 100644 index 00000000000..ed5e3c15693 --- /dev/null +++ b/libgfortran/generated/_abs_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__abs_c4 + + specific__abs_c4 = abs (parm) +end function diff --git a/libgfortran/generated/_abs_c8.f90 b/libgfortran/generated/_abs_c8.f90 new file mode 100644 index 00000000000..714064cd8a1 --- /dev/null +++ b/libgfortran/generated/_abs_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__abs_c8 + + specific__abs_c8 = abs (parm) +end function diff --git a/libgfortran/generated/_abs_i4.f90 b/libgfortran/generated/_abs_i4.f90 new file mode 100644 index 00000000000..146ec072bd8 --- /dev/null +++ b/libgfortran/generated/_abs_i4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_i4 (parm) + integer (kind=4), intent (in) :: parm + integer (kind=4) :: specific__abs_i4 + + specific__abs_i4 = abs (parm) +end function diff --git a/libgfortran/generated/_abs_i8.f90 b/libgfortran/generated/_abs_i8.f90 new file mode 100644 index 00000000000..033ec30e94c --- /dev/null +++ b/libgfortran/generated/_abs_i8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_i8 (parm) + integer (kind=8), intent (in) :: parm + integer (kind=8) :: specific__abs_i8 + + specific__abs_i8 = abs (parm) +end function diff --git a/libgfortran/generated/_abs_r4.f90 b/libgfortran/generated/_abs_r4.f90 new file mode 100644 index 00000000000..18f3f6b2ccf --- /dev/null +++ b/libgfortran/generated/_abs_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__abs_r4 + + specific__abs_r4 = abs (parm) +end function diff --git a/libgfortran/generated/_abs_r8.f90 b/libgfortran/generated/_abs_r8.f90 new file mode 100644 index 00000000000..3dc1c8b3e84 --- /dev/null +++ b/libgfortran/generated/_abs_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__abs_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__abs_r8 + + specific__abs_r8 = abs (parm) +end function diff --git a/libgfortran/generated/_acos_r4.f90 b/libgfortran/generated/_acos_r4.f90 new file mode 100644 index 00000000000..2f49b3093c2 --- /dev/null +++ b/libgfortran/generated/_acos_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__acos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__acos_r4 + + specific__acos_r4 = acos (parm) +end function diff --git a/libgfortran/generated/_acos_r8.f90 b/libgfortran/generated/_acos_r8.f90 new file mode 100644 index 00000000000..d285c4566d6 --- /dev/null +++ b/libgfortran/generated/_acos_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__acos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__acos_r8 + + specific__acos_r8 = acos (parm) +end function diff --git a/libgfortran/generated/_aint_r4.f90 b/libgfortran/generated/_aint_r4.f90 new file mode 100644 index 00000000000..5c2b641707b --- /dev/null +++ b/libgfortran/generated/_aint_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__aint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__aint_r4 + + specific__aint_r4 = aint (parm) +end function diff --git a/libgfortran/generated/_aint_r8.f90 b/libgfortran/generated/_aint_r8.f90 new file mode 100644 index 00000000000..65c675458c3 --- /dev/null +++ b/libgfortran/generated/_aint_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__aint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__aint_r8 + + specific__aint_r8 = aint (parm) +end function diff --git a/libgfortran/generated/_anint_r4.f90 b/libgfortran/generated/_anint_r4.f90 new file mode 100644 index 00000000000..9056f0077d9 --- /dev/null +++ b/libgfortran/generated/_anint_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__anint_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__anint_r4 + + specific__anint_r4 = anint (parm) +end function diff --git a/libgfortran/generated/_anint_r8.f90 b/libgfortran/generated/_anint_r8.f90 new file mode 100644 index 00000000000..46d87e07934 --- /dev/null +++ b/libgfortran/generated/_anint_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__anint_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__anint_r8 + + specific__anint_r8 = anint (parm) +end function diff --git a/libgfortran/generated/_asin_r4.f90 b/libgfortran/generated/_asin_r4.f90 new file mode 100644 index 00000000000..bf4dfa48304 --- /dev/null +++ b/libgfortran/generated/_asin_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__asin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__asin_r4 + + specific__asin_r4 = asin (parm) +end function diff --git a/libgfortran/generated/_asin_r8.f90 b/libgfortran/generated/_asin_r8.f90 new file mode 100644 index 00000000000..37adbc64a68 --- /dev/null +++ b/libgfortran/generated/_asin_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__asin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__asin_r8 + + specific__asin_r8 = asin (parm) +end function diff --git a/libgfortran/generated/_atan2_r4.f90 b/libgfortran/generated/_atan2_r4.f90 new file mode 100644 index 00000000000..fddda221f12 --- /dev/null +++ b/libgfortran/generated/_atan2_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__atan2_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__atan2_r4 + + specific__atan2_r4 = atan2 (p1, p2) +end function diff --git a/libgfortran/generated/_atan2_r8.f90 b/libgfortran/generated/_atan2_r8.f90 new file mode 100644 index 00000000000..76ec23c0ad4 --- /dev/null +++ b/libgfortran/generated/_atan2_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__atan2_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__atan2_r8 + + specific__atan2_r8 = atan2 (p1, p2) +end function diff --git a/libgfortran/generated/_atan_r4.f90 b/libgfortran/generated/_atan_r4.f90 new file mode 100644 index 00000000000..0918d7f3f12 --- /dev/null +++ b/libgfortran/generated/_atan_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__atan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__atan_r4 + + specific__atan_r4 = atan (parm) +end function diff --git a/libgfortran/generated/_atan_r8.f90 b/libgfortran/generated/_atan_r8.f90 new file mode 100644 index 00000000000..71fe2e730c2 --- /dev/null +++ b/libgfortran/generated/_atan_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__atan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__atan_r8 + + specific__atan_r8 = atan (parm) +end function diff --git a/libgfortran/generated/_conjg_c4.f90 b/libgfortran/generated/_conjg_c4.f90 new file mode 100644 index 00000000000..3d799ffd372 --- /dev/null +++ b/libgfortran/generated/_conjg_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__conjg_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__conjg_c4 + + specific__conjg_c4 = conjg (parm) +end function diff --git a/libgfortran/generated/_conjg_c8.f90 b/libgfortran/generated/_conjg_c8.f90 new file mode 100644 index 00000000000..a8d4957c369 --- /dev/null +++ b/libgfortran/generated/_conjg_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__conjg_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__conjg_c8 + + specific__conjg_c8 = conjg (parm) +end function diff --git a/libgfortran/generated/_cos_c4.f90 b/libgfortran/generated/_cos_c4.f90 new file mode 100644 index 00000000000..40f772a96fe --- /dev/null +++ b/libgfortran/generated/_cos_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cos_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__cos_c4 + + specific__cos_c4 = cos (parm) +end function diff --git a/libgfortran/generated/_cos_c8.f90 b/libgfortran/generated/_cos_c8.f90 new file mode 100644 index 00000000000..7ae0d1ed7e3 --- /dev/null +++ b/libgfortran/generated/_cos_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cos_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__cos_c8 + + specific__cos_c8 = cos (parm) +end function diff --git a/libgfortran/generated/_cos_r4.f90 b/libgfortran/generated/_cos_r4.f90 new file mode 100644 index 00000000000..186900ed05a --- /dev/null +++ b/libgfortran/generated/_cos_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cos_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__cos_r4 + + specific__cos_r4 = cos (parm) +end function diff --git a/libgfortran/generated/_cos_r8.f90 b/libgfortran/generated/_cos_r8.f90 new file mode 100644 index 00000000000..6842d9109f0 --- /dev/null +++ b/libgfortran/generated/_cos_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cos_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__cos_r8 + + specific__cos_r8 = cos (parm) +end function diff --git a/libgfortran/generated/_cosh_r4.f90 b/libgfortran/generated/_cosh_r4.f90 new file mode 100644 index 00000000000..2e40c85f2f1 --- /dev/null +++ b/libgfortran/generated/_cosh_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cosh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__cosh_r4 + + specific__cosh_r4 = cosh (parm) +end function diff --git a/libgfortran/generated/_cosh_r8.f90 b/libgfortran/generated/_cosh_r8.f90 new file mode 100644 index 00000000000..ef1ab85b0d0 --- /dev/null +++ b/libgfortran/generated/_cosh_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__cosh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__cosh_r8 + + specific__cosh_r8 = cosh (parm) +end function diff --git a/libgfortran/generated/_dim_i4.f90 b/libgfortran/generated/_dim_i4.f90 new file mode 100644 index 00000000000..e46a34f46ff --- /dev/null +++ b/libgfortran/generated/_dim_i4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__dim_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__dim_i4 + + specific__dim_i4 = dim (p1, p2) +end function diff --git a/libgfortran/generated/_dim_i8.f90 b/libgfortran/generated/_dim_i8.f90 new file mode 100644 index 00000000000..fa823280b83 --- /dev/null +++ b/libgfortran/generated/_dim_i8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__dim_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__dim_i8 + + specific__dim_i8 = dim (p1, p2) +end function diff --git a/libgfortran/generated/_dim_r4.f90 b/libgfortran/generated/_dim_r4.f90 new file mode 100644 index 00000000000..1841ae7a033 --- /dev/null +++ b/libgfortran/generated/_dim_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__dim_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__dim_r4 + + specific__dim_r4 = dim (p1, p2) +end function diff --git a/libgfortran/generated/_dim_r8.f90 b/libgfortran/generated/_dim_r8.f90 new file mode 100644 index 00000000000..8de846adce2 --- /dev/null +++ b/libgfortran/generated/_dim_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__dim_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__dim_r8 + + specific__dim_r8 = dim (p1, p2) +end function diff --git a/libgfortran/generated/_exp_c4.f90 b/libgfortran/generated/_exp_c4.f90 new file mode 100644 index 00000000000..530be220218 --- /dev/null +++ b/libgfortran/generated/_exp_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__exp_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__exp_c4 + + specific__exp_c4 = exp (parm) +end function diff --git a/libgfortran/generated/_exp_c8.f90 b/libgfortran/generated/_exp_c8.f90 new file mode 100644 index 00000000000..933c5606253 --- /dev/null +++ b/libgfortran/generated/_exp_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__exp_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__exp_c8 + + specific__exp_c8 = exp (parm) +end function diff --git a/libgfortran/generated/_exp_r4.f90 b/libgfortran/generated/_exp_r4.f90 new file mode 100644 index 00000000000..ec56a495c45 --- /dev/null +++ b/libgfortran/generated/_exp_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__exp_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__exp_r4 + + specific__exp_r4 = exp (parm) +end function diff --git a/libgfortran/generated/_exp_r8.f90 b/libgfortran/generated/_exp_r8.f90 new file mode 100644 index 00000000000..fcd8d7d15a4 --- /dev/null +++ b/libgfortran/generated/_exp_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__exp_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__exp_r8 + + specific__exp_r8 = exp (parm) +end function diff --git a/libgfortran/generated/_log10_r4.f90 b/libgfortran/generated/_log10_r4.f90 new file mode 100644 index 00000000000..0d0d854db41 --- /dev/null +++ b/libgfortran/generated/_log10_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log10_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__log10_r4 + + specific__log10_r4 = log10 (parm) +end function diff --git a/libgfortran/generated/_log10_r8.f90 b/libgfortran/generated/_log10_r8.f90 new file mode 100644 index 00000000000..360e9b59c54 --- /dev/null +++ b/libgfortran/generated/_log10_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log10_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__log10_r8 + + specific__log10_r8 = log10 (parm) +end function diff --git a/libgfortran/generated/_log_c4.f90 b/libgfortran/generated/_log_c4.f90 new file mode 100644 index 00000000000..615c00a0272 --- /dev/null +++ b/libgfortran/generated/_log_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__log_c4 + + specific__log_c4 = log (parm) +end function diff --git a/libgfortran/generated/_log_c8.f90 b/libgfortran/generated/_log_c8.f90 new file mode 100644 index 00000000000..38c757cb1b9 --- /dev/null +++ b/libgfortran/generated/_log_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__log_c8 + + specific__log_c8 = log (parm) +end function diff --git a/libgfortran/generated/_log_r4.f90 b/libgfortran/generated/_log_r4.f90 new file mode 100644 index 00000000000..5cbe7d1a92e --- /dev/null +++ b/libgfortran/generated/_log_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__log_r4 + + specific__log_r4 = log (parm) +end function diff --git a/libgfortran/generated/_log_r8.f90 b/libgfortran/generated/_log_r8.f90 new file mode 100644 index 00000000000..7e0491297fd --- /dev/null +++ b/libgfortran/generated/_log_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__log_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__log_r8 + + specific__log_r8 = log (parm) +end function diff --git a/libgfortran/generated/_mod_i4.f90 b/libgfortran/generated/_mod_i4.f90 new file mode 100644 index 00000000000..396502960d0 --- /dev/null +++ b/libgfortran/generated/_mod_i4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__mod_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__mod_i4 + + specific__mod_i4 = mod (p1, p2) +end function diff --git a/libgfortran/generated/_mod_i8.f90 b/libgfortran/generated/_mod_i8.f90 new file mode 100644 index 00000000000..57552abb569 --- /dev/null +++ b/libgfortran/generated/_mod_i8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__mod_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__mod_i8 + + specific__mod_i8 = mod (p1, p2) +end function diff --git a/libgfortran/generated/_mod_r4.f90 b/libgfortran/generated/_mod_r4.f90 new file mode 100644 index 00000000000..6fe164fa645 --- /dev/null +++ b/libgfortran/generated/_mod_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__mod_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__mod_r4 + + specific__mod_r4 = mod (p1, p2) +end function diff --git a/libgfortran/generated/_mod_r8.f90 b/libgfortran/generated/_mod_r8.f90 new file mode 100644 index 00000000000..4857a66130b --- /dev/null +++ b/libgfortran/generated/_mod_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__mod_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__mod_r8 + + specific__mod_r8 = mod (p1, p2) +end function diff --git a/libgfortran/generated/_sign_i4.f90 b/libgfortran/generated/_sign_i4.f90 new file mode 100644 index 00000000000..db695b19ac7 --- /dev/null +++ b/libgfortran/generated/_sign_i4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sign_i4 (p1, p2) + integer (kind=4), intent (in) :: p1, p2 + integer (kind=4) :: specific__sign_i4 + + specific__sign_i4 = sign (p1, p2) +end function diff --git a/libgfortran/generated/_sign_i8.f90 b/libgfortran/generated/_sign_i8.f90 new file mode 100644 index 00000000000..d46ebb7ca49 --- /dev/null +++ b/libgfortran/generated/_sign_i8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sign_i8 (p1, p2) + integer (kind=8), intent (in) :: p1, p2 + integer (kind=8) :: specific__sign_i8 + + specific__sign_i8 = sign (p1, p2) +end function diff --git a/libgfortran/generated/_sign_r4.f90 b/libgfortran/generated/_sign_r4.f90 new file mode 100644 index 00000000000..fe68f510f11 --- /dev/null +++ b/libgfortran/generated/_sign_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sign_r4 (p1, p2) + real (kind=4), intent (in) :: p1, p2 + real (kind=4) :: specific__sign_r4 + + specific__sign_r4 = sign (p1, p2) +end function diff --git a/libgfortran/generated/_sign_r8.f90 b/libgfortran/generated/_sign_r8.f90 new file mode 100644 index 00000000000..3a0f109fdd6 --- /dev/null +++ b/libgfortran/generated/_sign_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sign_r8 (p1, p2) + real (kind=8), intent (in) :: p1, p2 + real (kind=8) :: specific__sign_r8 + + specific__sign_r8 = sign (p1, p2) +end function diff --git a/libgfortran/generated/_sin_c4.f90 b/libgfortran/generated/_sin_c4.f90 new file mode 100644 index 00000000000..7d9cb36e5a3 --- /dev/null +++ b/libgfortran/generated/_sin_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sin_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__sin_c4 + + specific__sin_c4 = sin (parm) +end function diff --git a/libgfortran/generated/_sin_c8.f90 b/libgfortran/generated/_sin_c8.f90 new file mode 100644 index 00000000000..d9d929628eb --- /dev/null +++ b/libgfortran/generated/_sin_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sin_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__sin_c8 + + specific__sin_c8 = sin (parm) +end function diff --git a/libgfortran/generated/_sin_r4.f90 b/libgfortran/generated/_sin_r4.f90 new file mode 100644 index 00000000000..f531afc774e --- /dev/null +++ b/libgfortran/generated/_sin_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sin_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sin_r4 + + specific__sin_r4 = sin (parm) +end function diff --git a/libgfortran/generated/_sin_r8.f90 b/libgfortran/generated/_sin_r8.f90 new file mode 100644 index 00000000000..d385d5c365a --- /dev/null +++ b/libgfortran/generated/_sin_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sin_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sin_r8 + + specific__sin_r8 = sin (parm) +end function diff --git a/libgfortran/generated/_sinh_r4.f90 b/libgfortran/generated/_sinh_r4.f90 new file mode 100644 index 00000000000..24f1fa80154 --- /dev/null +++ b/libgfortran/generated/_sinh_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sinh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sinh_r4 + + specific__sinh_r4 = sinh (parm) +end function diff --git a/libgfortran/generated/_sinh_r8.f90 b/libgfortran/generated/_sinh_r8.f90 new file mode 100644 index 00000000000..6b166de8d22 --- /dev/null +++ b/libgfortran/generated/_sinh_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sinh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sinh_r8 + + specific__sinh_r8 = sinh (parm) +end function diff --git a/libgfortran/generated/_sqrt_c4.f90 b/libgfortran/generated/_sqrt_c4.f90 new file mode 100644 index 00000000000..2377f25b498 --- /dev/null +++ b/libgfortran/generated/_sqrt_c4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sqrt_c4 (parm) + complex (kind=4), intent (in) :: parm + complex (kind=4) :: specific__sqrt_c4 + + specific__sqrt_c4 = sqrt (parm) +end function diff --git a/libgfortran/generated/_sqrt_c8.f90 b/libgfortran/generated/_sqrt_c8.f90 new file mode 100644 index 00000000000..c32da20f164 --- /dev/null +++ b/libgfortran/generated/_sqrt_c8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sqrt_c8 (parm) + complex (kind=8), intent (in) :: parm + complex (kind=8) :: specific__sqrt_c8 + + specific__sqrt_c8 = sqrt (parm) +end function diff --git a/libgfortran/generated/_sqrt_r4.f90 b/libgfortran/generated/_sqrt_r4.f90 new file mode 100644 index 00000000000..62416e79d34 --- /dev/null +++ b/libgfortran/generated/_sqrt_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sqrt_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__sqrt_r4 + + specific__sqrt_r4 = sqrt (parm) +end function diff --git a/libgfortran/generated/_sqrt_r8.f90 b/libgfortran/generated/_sqrt_r8.f90 new file mode 100644 index 00000000000..3928cd46383 --- /dev/null +++ b/libgfortran/generated/_sqrt_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__sqrt_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__sqrt_r8 + + specific__sqrt_r8 = sqrt (parm) +end function diff --git a/libgfortran/generated/_tan_r4.f90 b/libgfortran/generated/_tan_r4.f90 new file mode 100644 index 00000000000..aaf26b19175 --- /dev/null +++ b/libgfortran/generated/_tan_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__tan_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__tan_r4 + + specific__tan_r4 = tan (parm) +end function diff --git a/libgfortran/generated/_tan_r8.f90 b/libgfortran/generated/_tan_r8.f90 new file mode 100644 index 00000000000..eca6d228355 --- /dev/null +++ b/libgfortran/generated/_tan_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__tan_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__tan_r8 + + specific__tan_r8 = tan (parm) +end function diff --git a/libgfortran/generated/_tanh_r4.f90 b/libgfortran/generated/_tanh_r4.f90 new file mode 100644 index 00000000000..b027ed6c251 --- /dev/null +++ b/libgfortran/generated/_tanh_r4.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__tanh_r4 (parm) + real (kind=4), intent (in) :: parm + real (kind=4) :: specific__tanh_r4 + + specific__tanh_r4 = tanh (parm) +end function diff --git a/libgfortran/generated/_tanh_r8.f90 b/libgfortran/generated/_tanh_r8.f90 new file mode 100644 index 00000000000..a5bbf18fefd --- /dev/null +++ b/libgfortran/generated/_tanh_r8.f90 @@ -0,0 +1,29 @@ +! Copyright 2002 Free Software Foundation, Inc. +! Contributed by Paul Brook <paul@nowt.org> +! +!This file is part of the GNU Fortran 95 runtime library (libgfor). +! +!GNU libgfor is free software; you can redistribute it and/or +!modify it under the terms of the GNU Lesser General Public +!License as published by the Free Software Foundation; either +!version 2.1 of the License, or (at your option) any later version. +! +!GNU libgfor is distributed in the hope that it will be useful, +!but WITHOUT ANY WARRANTY; without even the implied warranty of +!MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +!GNU Lesser General Public License for more details. +! +!You should have received a copy of the GNU Lesser General Public +!License along with libgfor; see the file COPYING. If not, +!write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +!Boston, MA 02111-1307, USA. +! +!This file is machine generated. + + +elemental function specific__tanh_r8 (parm) + real (kind=8), intent (in) :: parm + real (kind=8) :: specific__tanh_r8 + + specific__tanh_r8 = tanh (parm) +end function diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c new file mode 100644 index 00000000000..5bfeeab328e --- /dev/null +++ b/libgfortran/generated/all_l4.c @@ -0,0 +1,133 @@ +/* Implementation of the ALL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__all_l4 (gfc_array_l4 * retarray, gfc_array_l4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_4 *base; + GFC_LOGICAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_4 *src; + GFC_LOGICAL_4 result; + src = base; + { + + /* Return true only if all the elements are set. */ + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (! *src) + { + result = 0; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c new file mode 100644 index 00000000000..b47b128dbba --- /dev/null +++ b/libgfortran/generated/all_l8.c @@ -0,0 +1,133 @@ +/* Implementation of the ALL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__all_l8 (gfc_array_l8 * retarray, gfc_array_l8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_8 *base; + GFC_LOGICAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_8 *src; + GFC_LOGICAL_8 result; + src = base; + { + + /* Return true only if all the elements are set. */ + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (! *src) + { + result = 0; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c new file mode 100644 index 00000000000..6abb9025e11 --- /dev/null +++ b/libgfortran/generated/any_l4.c @@ -0,0 +1,133 @@ +/* Implementation of the ANY intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__any_l4 (gfc_array_l4 * retarray, gfc_array_l4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_4 *base; + GFC_LOGICAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_4 *src; + GFC_LOGICAL_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + /* Return true if any of the elements are set. */ + if (*src) + { + result = 1; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c new file mode 100644 index 00000000000..20e0c4693a0 --- /dev/null +++ b/libgfortran/generated/any_l8.c @@ -0,0 +1,133 @@ +/* Implementation of the ANY intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__any_l8 (gfc_array_l8 * retarray, gfc_array_l8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_8 *base; + GFC_LOGICAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_8 *src; + GFC_LOGICAL_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + /* Return true if any of the elements are set. */ + if (*src) + { + result = 1; + break; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/count_4_l4.c b/libgfortran/generated/count_4_l4.c new file mode 100644 index 00000000000..959c8b8a371 --- /dev/null +++ b/libgfortran/generated/count_4_l4.c @@ -0,0 +1,129 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__count_4_l4 (gfc_array_i4 * retarray, gfc_array_l4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/count_4_l8.c b/libgfortran/generated/count_4_l8.c new file mode 100644 index 00000000000..3879e9bee78 --- /dev/null +++ b/libgfortran/generated/count_4_l8.c @@ -0,0 +1,129 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__count_4_l8 (gfc_array_i4 * retarray, gfc_array_l8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_8 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/count_8_l4.c b/libgfortran/generated/count_8_l4.c new file mode 100644 index 00000000000..67b6ec32280 --- /dev/null +++ b/libgfortran/generated/count_8_l4.c @@ -0,0 +1,129 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__count_8_l4 (gfc_array_i8 * retarray, gfc_array_l4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_4 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/count_8_l8.c b/libgfortran/generated/count_8_l8.c new file mode 100644 index 00000000000..93d6c2d281a --- /dev/null +++ b/libgfortran/generated/count_8_l8.c @@ -0,0 +1,129 @@ +/* Implementation of the COUNT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__count_8_l8 (gfc_array_i8 * retarray, gfc_array_l8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_LOGICAL_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_LOGICAL_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src) + result++; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c new file mode 100644 index 00000000000..9375074db2a --- /dev/null +++ b/libgfortran/generated/cshift1_4.c @@ -0,0 +1,170 @@ +/* Implementation of the CSHIFT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Feng Wang <wf_cs@yahoo.com> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +void +__cshift1_4 (const gfc_array_char * ret, const gfc_array_char * array, + const gfc_array_i4 * h, const GFC_INTEGER_4 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_4 *hptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_4 sh; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) + runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + +/* Initialized for avoiding compiler warnings. */ + roffset = size; + soffset = size; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + sh = (div (sh, len)).rem; + if (sh < 0) + sh += len; + + src = &sptr[sh * soffset]; + dest = rptr; + + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + if (n == len - sh - 1) + src = sptr; + else + src += soffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c new file mode 100644 index 00000000000..7303d560440 --- /dev/null +++ b/libgfortran/generated/cshift1_8.c @@ -0,0 +1,170 @@ +/* Implementation of the CSHIFT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Feng Wang <wf_cs@yahoo.com> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +void +__cshift1_8 (const gfc_array_char * ret, const gfc_array_char * array, + const gfc_array_i8 * h, const GFC_INTEGER_8 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_8 *hptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_8 sh; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (which < 0 || (which + 1) > GFC_DESCRIPTOR_RANK (array)) + runtime_error ("Argument 'DIM' is out of range in call to 'CSHIFT'"); + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + +/* Initialized for avoiding compiler warnings. */ + roffset = size; + soffset = size; + len = 0; + + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + sh = (div (sh, len)).rem; + if (sh < 0) + sh += len; + + src = &sptr[sh * soffset]; + dest = rptr; + + for (n = 0; n < len; n++) + { + memcpy (dest, src, size); + dest += roffset; + if (n == len - sh - 1) + src = sptr; + else + src += soffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/dotprod_c4.c b/libgfortran/generated/dotprod_c4.c new file mode 100644 index 00000000000..9812ab4e3c8 --- /dev/null +++ b/libgfortran/generated/dotprod_c4.c @@ -0,0 +1,67 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + and Feng Wang <fengwang@nudt.edu.cn> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_COMPLEX_4 +__dot_product_c4 (gfc_array_c4 * a, gfc_array_c4 * b) +{ + GFC_COMPLEX_4 *pa; + GFC_COMPLEX_4 *pb; + GFC_COMPLEX_4 res; + GFC_COMPLEX_4 conjga; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa)); + res += conjga * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/dotprod_c8.c b/libgfortran/generated/dotprod_c8.c new file mode 100644 index 00000000000..fde18021400 --- /dev/null +++ b/libgfortran/generated/dotprod_c8.c @@ -0,0 +1,67 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + and Feng Wang <fengwang@nudt.edu.cn> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_COMPLEX_8 +__dot_product_c8 (gfc_array_c8 * a, gfc_array_c8 * b) +{ + GFC_COMPLEX_8 *pa; + GFC_COMPLEX_8 *pb; + GFC_COMPLEX_8 res; + GFC_COMPLEX_8 conjga; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa)); + res += conjga * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/dotprod_i4.c b/libgfortran/generated/dotprod_i4.c new file mode 100644 index 00000000000..374d9251300 --- /dev/null +++ b/libgfortran/generated/dotprod_i4.c @@ -0,0 +1,64 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_INTEGER_4 +__dot_product_i4 (gfc_array_i4 * a, gfc_array_i4 * b) +{ + GFC_INTEGER_4 *pa; + GFC_INTEGER_4 *pb; + GFC_INTEGER_4 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/dotprod_i8.c b/libgfortran/generated/dotprod_i8.c new file mode 100644 index 00000000000..6702a1d489c --- /dev/null +++ b/libgfortran/generated/dotprod_i8.c @@ -0,0 +1,64 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_INTEGER_8 +__dot_product_i8 (gfc_array_i8 * a, gfc_array_i8 * b) +{ + GFC_INTEGER_8 *pa; + GFC_INTEGER_8 *pb; + GFC_INTEGER_8 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/dotprod_l4.c b/libgfortran/generated/dotprod_l4.c new file mode 100644 index 00000000000..292c0386cd1 --- /dev/null +++ b/libgfortran/generated/dotprod_l4.c @@ -0,0 +1,74 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +GFC_LOGICAL_4 +__dot_product_l4 (gfc_array_l4 * a, gfc_array_l4 * b) +{ + GFC_LOGICAL_4 *pa; + GFC_LOGICAL_4 *pb; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + + pa = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + pa = GFOR_POINTER_L8_TO_L4 (pa); + astride <<= 1; + } + pb = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + pb = GFOR_POINTER_L8_TO_L4 (pb); + bstride <<= 1; + } + + while (count--) + { + if (*pa && *pb) + return 1; + + pa += astride; + pb += bstride; + } + + return 0; +} + diff --git a/libgfortran/generated/dotprod_l8.c b/libgfortran/generated/dotprod_l8.c new file mode 100644 index 00000000000..4316607a3e5 --- /dev/null +++ b/libgfortran/generated/dotprod_l8.c @@ -0,0 +1,74 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +GFC_LOGICAL_8 +__dot_product_l8 (gfc_array_l4 * a, gfc_array_l4 * b) +{ + GFC_LOGICAL_4 *pa; + GFC_LOGICAL_4 *pb; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + + pa = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + pa = GFOR_POINTER_L8_TO_L4 (pa); + astride <<= 1; + } + pb = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + pb = GFOR_POINTER_L8_TO_L4 (pb); + bstride <<= 1; + } + + while (count--) + { + if (*pa && *pb) + return 1; + + pa += astride; + pb += bstride; + } + + return 0; +} + diff --git a/libgfortran/generated/dotprod_r4.c b/libgfortran/generated/dotprod_r4.c new file mode 100644 index 00000000000..1edfea36e6e --- /dev/null +++ b/libgfortran/generated/dotprod_r4.c @@ -0,0 +1,64 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_REAL_4 +__dot_product_r4 (gfc_array_r4 * a, gfc_array_r4 * b) +{ + GFC_REAL_4 *pa; + GFC_REAL_4 *pb; + GFC_REAL_4 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/dotprod_r8.c b/libgfortran/generated/dotprod_r8.c new file mode 100644 index 00000000000..bf35710272b --- /dev/null +++ b/libgfortran/generated/dotprod_r8.c @@ -0,0 +1,64 @@ +/* Implementation of the DOT_PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array; + +/* Both parameters will already have been converted to the result type. */ +GFC_REAL_8 +__dot_product_r8 (gfc_array_r8 * a, gfc_array_r8 * b) +{ + GFC_REAL_8 *pa; + GFC_REAL_8 *pb; + GFC_REAL_8 res; + index_type count; + index_type astride; + index_type bstride; + + assert (GFC_DESCRIPTOR_RANK (a) == 1 + && GFC_DESCRIPTOR_RANK (b) == 1); + + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + astride = a->dim[0].stride; + bstride = b->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + res = 0; + pa = a->data; + pb = b->data; + + while (count--) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + return res; +} + diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c new file mode 100644 index 00000000000..05b1af682e0 --- /dev/null +++ b/libgfortran/generated/eoshift1_4.c @@ -0,0 +1,178 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +static const char zeros[16] = + {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; + +void +__eoshift1_4 (const gfc_array_char * ret, const gfc_array_char * array, + const gfc_array_i4 * h, const char * pbound, const GFC_INTEGER_4 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_4 *hptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_4 sh; + GFC_INTEGER_4 delta; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (!pbound) + pbound = zeros; + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + delta = (sh >= 0) ? sh: -sh; + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + while (n--) + { + memcpy (dest, pbound, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c new file mode 100644 index 00000000000..f74c022f178 --- /dev/null +++ b/libgfortran/generated/eoshift1_8.c @@ -0,0 +1,178 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +static const char zeros[16] = + {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; + +void +__eoshift1_8 (const gfc_array_char * ret, const gfc_array_char * array, + const gfc_array_i8 * h, const char * pbound, const GFC_INTEGER_8 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_8 *hptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_8 sh; + GFC_INTEGER_8 delta; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + if (!pbound) + pbound = zeros; + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + delta = (sh >= 0) ? sh: -sh; + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + while (n--) + { + memcpy (dest, pbound, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c new file mode 100644 index 00000000000..07c2d9e965e --- /dev/null +++ b/libgfortran/generated/eoshift3_4.c @@ -0,0 +1,193 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +static const char zeros[16] = + {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; + +void +__eoshift3_4 (gfc_array_char * ret, gfc_array_char * array, + gfc_array_i4 * h, const gfc_array_char * bound, GFC_INTEGER_4 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_4 *hptr; + /* b.* indicates the bound array. */ + index_type bstride[GFC_MAX_DIMENSIONS - 1]; + index_type bstride0; + const char *bptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_4 sh; + GFC_INTEGER_4 delta; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + if (bound) + bstride[n] = bound->dim[n].stride; + else + bstride[n] = 0; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + if (bound && bstride[0] == 0) + bstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + bstride0 = bstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + if (bound) + bptr = bound->data; + else + bptr = zeros; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + delta = (sh >= 0) ? sh: -sh; + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + while (n--) + { + memcpy (dest, bptr, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + bptr += bstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + bptr -= bstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + bptr += bstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c new file mode 100644 index 00000000000..fcb161df39a --- /dev/null +++ b/libgfortran/generated/eoshift3_8.c @@ -0,0 +1,193 @@ +/* Implementation of the EOSHIFT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +static const char zeros[16] = + {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}; + +void +__eoshift3_8 (gfc_array_char * ret, gfc_array_char * array, + gfc_array_i8 * h, const gfc_array_char * bound, GFC_INTEGER_8 * pwhich) +{ + /* r.* indicates the return array. */ + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type roffset; + char *rptr; + char *dest; + /* s.* indicates the source array. */ + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type soffset; + const char *sptr; + const char *src; + /* h.* indicates the shift array. */ + index_type hstride[GFC_MAX_DIMENSIONS - 1]; + index_type hstride0; + const GFC_INTEGER_8 *hptr; + /* b.* indicates the bound array. */ + index_type bstride[GFC_MAX_DIMENSIONS - 1]; + index_type bstride0; + const char *bptr; + + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type dim; + index_type size; + index_type len; + index_type n; + int which; + GFC_INTEGER_8 sh; + GFC_INTEGER_8 delta; + + if (pwhich) + which = *pwhich - 1; + else + which = 0; + + size = GFC_DESCRIPTOR_SIZE (ret); + + extent[0] = 1; + count[0] = 0; + size = GFC_DESCRIPTOR_SIZE (array); + n = 0; + for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) + { + if (dim == which) + { + roffset = ret->dim[dim].stride * size; + if (roffset == 0) + roffset = size; + soffset = array->dim[dim].stride * size; + if (soffset == 0) + soffset = size; + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + } + else + { + count[n] = 0; + extent[n] = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + rstride[n] = ret->dim[dim].stride * size; + sstride[n] = array->dim[dim].stride * size; + + hstride[n] = h->dim[n].stride; + if (bound) + bstride[n] = bound->dim[n].stride; + else + bstride[n] = 0; + n++; + } + } + if (sstride[0] == 0) + sstride[0] = size; + if (rstride[0] == 0) + rstride[0] = size; + if (hstride[0] == 0) + hstride[0] = 1; + if (bound && bstride[0] == 0) + bstride[0] = size; + + dim = GFC_DESCRIPTOR_RANK (array); + rstride0 = rstride[0]; + sstride0 = sstride[0]; + hstride0 = hstride[0]; + bstride0 = bstride[0]; + rptr = ret->data; + sptr = array->data; + hptr = h->data; + if (bound) + bptr = bound->data; + else + bptr = zeros; + + while (rptr) + { + /* Do the shift for this dimension. */ + sh = *hptr; + delta = (sh >= 0) ? sh: -sh; + if (sh > 0) + { + src = &sptr[delta * soffset]; + dest = rptr; + } + else + { + src = sptr; + dest = &rptr[delta * roffset]; + } + for (n = 0; n < len - delta; n++) + { + memcpy (dest, src, size); + dest += roffset; + src += soffset; + } + if (sh < 0) + dest = rptr; + n = delta; + + while (n--) + { + memcpy (dest, bptr, size); + dest += roffset; + } + + /* Advance to the next section. */ + rptr += rstride0; + sptr += sstride0; + hptr += hstride0; + bptr += bstride0; + count[0]++; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * extent[n]; + sptr -= sstride[n] * extent[n]; + hptr -= hstride[n] * extent[n]; + bptr -= bstride[n] * extent[n]; + n++; + if (n >= dim - 1) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + count[n]++; + rptr += rstride[n]; + sptr += sstride[n]; + hptr += hstride[n]; + bptr += bstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/exp_c4.c b/libgfortran/generated/exp_c4.c new file mode 100644 index 00000000000..d95213446ee --- /dev/null +++ b/libgfortran/generated/exp_c4.c @@ -0,0 +1,139 @@ +/* Complex exponential functions + Copyright 2002, 2004 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* z = a + ib */ +/* Absolute value. */ +GFC_REAL_4 +cabsf (GFC_COMPLEX_4 z) +{ + return hypotf (REALPART (z), IMAGPART (z)); +} + +/* Complex argument. The angle made with the +ve real axis. Range 0-2pi. */ +GFC_REAL_4 +cargf (GFC_COMPLEX_4 z) +{ + GFC_REAL_4 arg; + + arg = atan2f (IMAGPART (z), REALPART (z)); + if (arg < 0) + return arg + 2 * M_PI; + else + return arg; +} + +/* exp(z) = exp(a)*(cos(b) + isin(b)) */ +GFC_COMPLEX_4 +cexpf (GFC_COMPLEX_4 z) +{ + GFC_REAL_4 a; + GFC_REAL_4 b; + GFC_COMPLEX_4 v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cosf (b), sinf (b)); + return expf (a) * v; +} + +/* log(z) = log (cabs(z)) + i*carg(z) */ +GFC_COMPLEX_4 +clogf (GFC_COMPLEX_4 z) +{ + GFC_COMPLEX_4 v; + + COMPLEX_ASSIGN (v, logf (cabsf (z)), cargf (z)); + return v; +} + +/* log10(z) = log10 (cabs(z)) + i*carg(z) */ +GFC_COMPLEX_4 +clog10f (GFC_COMPLEX_4 z) +{ + GFC_COMPLEX_4 v; + + COMPLEX_ASSIGN (v, log10f (cabsf (z)), cargf (z)); + return v; +} + +/* pow(base, power) = cexp (power * clog (base)) */ +GFC_COMPLEX_4 +cpowf (GFC_COMPLEX_4 base, GFC_COMPLEX_4 power) +{ + return cexpf (power * clogf (base)); +} + +/* sqrt(z). Algorithm pulled from glibc. */ +GFC_COMPLEX_4 +csqrtf (GFC_COMPLEX_4 z) +{ + GFC_REAL_4 re; + GFC_REAL_4 im; + GFC_COMPLEX_4 v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0.0) + { + if (re < 0.0) + { + COMPLEX_ASSIGN (v, 0.0, copysignf (sqrtf (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabsf (sqrt (re)), + copysignf (0.0, im)); + } + } + else if (re == 0.0) + { + GFC_REAL_4 r; + + r = sqrtf (0.5 * fabs (im)); + + COMPLEX_ASSIGN (v, copysignf (r, im), r); + } + else + { + GFC_REAL_4 d, r, s; + + d = hypotf (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrtf (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrtf (0.5 * d - 0.5 * re); + r = fabsf ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysignf (s, im)); + } + return v; +} + diff --git a/libgfortran/generated/exp_c8.c b/libgfortran/generated/exp_c8.c new file mode 100644 index 00000000000..74cbbdc5145 --- /dev/null +++ b/libgfortran/generated/exp_c8.c @@ -0,0 +1,139 @@ +/* Complex exponential functions + Copyright 2002, 2004 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* z = a + ib */ +/* Absolute value. */ +GFC_REAL_8 +cabs (GFC_COMPLEX_8 z) +{ + return hypot (REALPART (z), IMAGPART (z)); +} + +/* Complex argument. The angle made with the +ve real axis. Range 0-2pi. */ +GFC_REAL_8 +carg (GFC_COMPLEX_8 z) +{ + GFC_REAL_8 arg; + + arg = atan2 (IMAGPART (z), REALPART (z)); + if (arg < 0) + return arg + 2 * M_PI; + else + return arg; +} + +/* exp(z) = exp(a)*(cos(b) + isin(b)) */ +GFC_COMPLEX_8 +cexp (GFC_COMPLEX_8 z) +{ + GFC_REAL_8 a; + GFC_REAL_8 b; + GFC_COMPLEX_8 v; + + a = REALPART (z); + b = IMAGPART (z); + COMPLEX_ASSIGN (v, cos (b), sin (b)); + return exp (a) * v; +} + +/* log(z) = log (cabs(z)) + i*carg(z) */ +GFC_COMPLEX_8 +clog (GFC_COMPLEX_8 z) +{ + GFC_COMPLEX_8 v; + + COMPLEX_ASSIGN (v, log (cabs (z)), carg (z)); + return v; +} + +/* log10(z) = log10 (cabs(z)) + i*carg(z) */ +GFC_COMPLEX_8 +clog10 (GFC_COMPLEX_8 z) +{ + GFC_COMPLEX_8 v; + + COMPLEX_ASSIGN (v, log10 (cabs (z)), carg (z)); + return v; +} + +/* pow(base, power) = cexp (power * clog (base)) */ +GFC_COMPLEX_8 +cpow (GFC_COMPLEX_8 base, GFC_COMPLEX_8 power) +{ + return cexp (power * clog (base)); +} + +/* sqrt(z). Algorithm pulled from glibc. */ +GFC_COMPLEX_8 +csqrt (GFC_COMPLEX_8 z) +{ + GFC_REAL_8 re; + GFC_REAL_8 im; + GFC_COMPLEX_8 v; + + re = REALPART (z); + im = IMAGPART (z); + if (im == 0.0) + { + if (re < 0.0) + { + COMPLEX_ASSIGN (v, 0.0, copysign (sqrt (-re), im)); + } + else + { + COMPLEX_ASSIGN (v, fabs (sqrt (re)), + copysign (0.0, im)); + } + } + else if (re == 0.0) + { + GFC_REAL_8 r; + + r = sqrt (0.5 * fabs (im)); + + COMPLEX_ASSIGN (v, copysign (r, im), r); + } + else + { + GFC_REAL_8 d, r, s; + + d = hypot (re, im); + /* Use the identity 2 Re res Im res = Im x + to avoid cancellation error in d +/- Re x. */ + if (re > 0) + { + r = sqrt (0.5 * d + 0.5 * re); + s = (0.5 * im) / r; + } + else + { + s = sqrt (0.5 * d - 0.5 * re); + r = fabs ((0.5 * im) / s); + } + + COMPLEX_ASSIGN (v, r, copysign (s, im)); + } + return v; +} + diff --git a/libgfortran/generated/exponent_r4.c b/libgfortran/generated/exponent_r4.c new file mode 100644 index 00000000000..34e76b65edb --- /dev/null +++ b/libgfortran/generated/exponent_r4.c @@ -0,0 +1,31 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_INTEGER_4 +prefix(exponent_r4) (GFC_REAL_4 s) +{ + int ret; + frexpf (s, &ret); + return ret; +} diff --git a/libgfortran/generated/exponent_r8.c b/libgfortran/generated/exponent_r8.c new file mode 100644 index 00000000000..8a4101efd66 --- /dev/null +++ b/libgfortran/generated/exponent_r8.c @@ -0,0 +1,31 @@ +/* Implementation of the EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_INTEGER_4 +prefix(exponent_r8) (GFC_REAL_8 s) +{ + int ret; + frexp (s, &ret); + return ret; +} diff --git a/libgfortran/generated/fraction_r4.c b/libgfortran/generated/fraction_r4.c new file mode 100644 index 00000000000..a86e8292c71 --- /dev/null +++ b/libgfortran/generated/fraction_r4.c @@ -0,0 +1,30 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_REAL_4 +prefix(fraction_r4) (GFC_REAL_4 s) +{ + int dummy_exp; + return frexpf (s, &dummy_exp); +} diff --git a/libgfortran/generated/fraction_r8.c b/libgfortran/generated/fraction_r8.c new file mode 100644 index 00000000000..613c6ac702c --- /dev/null +++ b/libgfortran/generated/fraction_r8.c @@ -0,0 +1,30 @@ +/* Implementation of the FRACTION intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_REAL_8 +prefix(fraction_r8) (GFC_REAL_8 s) +{ + int dummy_exp; + return frexp (s, &dummy_exp); +} diff --git a/libgfortran/generated/hyp_c4.c b/libgfortran/generated/hyp_c4.c new file mode 100644 index 00000000000..ac6c1e03131 --- /dev/null +++ b/libgfortran/generated/hyp_c4.c @@ -0,0 +1,71 @@ +/* Complex hyperbolic functions + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* Complex number z = a + ib. */ + +/* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */ +GFC_COMPLEX_4 +csinhf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 r; + GFC_REAL_4 i; + GFC_COMPLEX_4 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinhf (r) * cosf (i), coshf (r) * sinf (i)); + return v; +} + +/* cosh(z) = cosh(a)cos(b) - isinh(a)sin(b) */ +GFC_COMPLEX_4 +ccoshf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 r; + GFC_REAL_4 i; + GFC_COMPLEX_4 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, coshf (r) * cosf (i), - (sinhf (r) * sinf (i))); + return v; +} + +/* tanh(z) = (tanh(a) + itan(b)) / (1 - itanh(a)tan(b)) */ +GFC_COMPLEX_4 +ctanhf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 rt; + GFC_REAL_4 it; + GFC_COMPLEX_4 n; + GFC_COMPLEX_4 d; + + rt = tanhf (REALPART (a)); + it = tanf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; +} + diff --git a/libgfortran/generated/hyp_c8.c b/libgfortran/generated/hyp_c8.c new file mode 100644 index 00000000000..b3793054941 --- /dev/null +++ b/libgfortran/generated/hyp_c8.c @@ -0,0 +1,71 @@ +/* Complex hyperbolic functions + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* Complex number z = a + ib. */ + +/* sinh(z) = sinh(a)cos(b) + icosh(a)sin(b) */ +GFC_COMPLEX_8 +csinh (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 r; + GFC_REAL_8 i; + GFC_COMPLEX_8 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinh (r) * cos (i), cosh (r) * sin (i)); + return v; +} + +/* cosh(z) = cosh(a)cos(b) - isinh(a)sin(b) */ +GFC_COMPLEX_8 +ccosh (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 r; + GFC_REAL_8 i; + GFC_COMPLEX_8 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosh (r) * cos (i), - (sinh (r) * sin (i))); + return v; +} + +/* tanh(z) = (tanh(a) + itan(b)) / (1 - itanh(a)tan(b)) */ +GFC_COMPLEX_8 +ctanh (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 rt; + GFC_REAL_8 it; + GFC_COMPLEX_8 n; + GFC_COMPLEX_8 d; + + rt = tanh (REALPART (a)); + it = tan (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d, 1, - (rt * it)); + + return n / d; +} + diff --git a/libgfortran/generated/in_pack_i4.c b/libgfortran/generated/in_pack_i4.c new file mode 100644 index 00000000000..f11295718fc --- /dev/null +++ b/libgfortran/generated/in_pack_i4.c @@ -0,0 +1,115 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfortran; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_4 * +internal_pack_4 (gfc_array_i4 * source) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type stride[GFC_MAX_DIMENSIONS - 1]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_INTEGER_4 *src; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_INTEGER_4 *)internal_malloc_size (ssize * 4); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; +} + diff --git a/libgfortran/generated/in_pack_i8.c b/libgfortran/generated/in_pack_i8.c new file mode 100644 index 00000000000..82609272e4a --- /dev/null +++ b/libgfortran/generated/in_pack_i8.c @@ -0,0 +1,115 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfortran; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +/* Allocates a block of memory with internal_malloc if the array needs + repacking. */ + +GFC_INTEGER_8 * +internal_pack_8 (gfc_array_i8 * source) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type stride[GFC_MAX_DIMENSIONS - 1]; + index_type stride0; + index_type dim; + index_type ssize; + const GFC_INTEGER_8 *src; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *destptr; + int n; + int packed; + + if (source->dim[0].stride == 0) + { + source->dim[0].stride = 1; + return source->data; + } + + dim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + packed = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = source->dim[n].stride; + extent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (extent[n] <= 0) + { + /* Do nothing. */ + packed = 1; + break; + } + + if (ssize != stride[n]) + packed = 0; + + ssize *= extent[n]; + } + + if (packed) + return source->data; + + /* Allocate storage for the destination. */ + destptr = (GFC_INTEGER_8 *)internal_malloc_size (ssize * 8); + dest = destptr; + src = source->data; + stride0 = stride[0]; + + + while (src) + { + /* Copy the data. */ + *(dest++) = *src; + /* Advance to the next element. */ + src += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= stride[n] * extent[n]; + n++; + if (n == dim) + { + src = NULL; + break; + } + else + { + count[n]++; + src += stride[n]; + } + } + } + return destptr; +} + diff --git a/libgfortran/generated/in_unpack_i4.c b/libgfortran/generated/in_unpack_i4.c new file mode 100644 index 00000000000..b0b7e7bc06d --- /dev/null +++ b/libgfortran/generated/in_unpack_i4.c @@ -0,0 +1,102 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +void +internal_unpack_4 (gfc_array_i4 * d, const GFC_INTEGER_4 * src) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type stride[GFC_MAX_DIMENSIONS - 1]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_INTEGER_4 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * 4); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + diff --git a/libgfortran/generated/in_unpack_i8.c b/libgfortran/generated/in_unpack_i8.c new file mode 100644 index 00000000000..962c05b6caa --- /dev/null +++ b/libgfortran/generated/in_unpack_i8.c @@ -0,0 +1,102 @@ +/* Helper function for repacking arrays. + Copyright 2003 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <string.h> +#include "libgfortran.h" + +void +internal_unpack_8 (gfc_array_i8 * d, const GFC_INTEGER_8 * src) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type stride[GFC_MAX_DIMENSIONS - 1]; + index_type stride0; + index_type dim; + index_type dsize; + GFC_INTEGER_8 *dest; + int n; + + dest = d->data; + if (src == dest || !src) + return; + + if (d->dim[0].stride == 0) + d->dim[0].stride = 1; + + dim = GFC_DESCRIPTOR_RANK (d); + dsize = 1; + for (n = 0; n < dim; n++) + { + count[n] = 0; + stride[n] = d->dim[n].stride; + extent[n] = d->dim[n].ubound + 1 - d->dim[n].lbound; + if (extent[n] <= 0) + abort (); + + if (dsize == stride[n]) + dsize *= extent[n]; + else + dsize = 0; + } + + if (dsize != 0) + { + memcpy (dest, src, dsize * 8); + return; + } + + stride0 = stride[0]; + + while (dest) + { + /* Copy the data. */ + *dest = *(src++); + /* Advance to the next element. */ + dest += stride0; + count[0]++; + /* Advance to the next source element. */ + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + dest -= stride[n] * extent[n]; + n++; + if (n == dim) + { + dest = NULL; + break; + } + else + { + count[n]++; + dest += stride[n]; + } + } + } +} + diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c new file mode 100644 index 00000000000..beb4453024e --- /dev/null +++ b/libgfortran/generated/matmul_c4.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_c4 (gfc_array_c4 * retarray, gfc_array_c4 * a, gfc_array_c4 * b) +{ + GFC_COMPLEX_4 *abase; + GFC_COMPLEX_4 *bbase; + GFC_COMPLEX_4 *dest; + GFC_COMPLEX_4 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_COMPLEX_4 *pa; + GFC_COMPLEX_4 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c new file mode 100644 index 00000000000..a306764d4b9 --- /dev/null +++ b/libgfortran/generated/matmul_c8.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_c8 (gfc_array_c8 * retarray, gfc_array_c8 * a, gfc_array_c8 * b) +{ + GFC_COMPLEX_8 *abase; + GFC_COMPLEX_8 *bbase; + GFC_COMPLEX_8 *dest; + GFC_COMPLEX_8 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_COMPLEX_8 *pa; + GFC_COMPLEX_8 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c new file mode 100644 index 00000000000..44b30a4e140 --- /dev/null +++ b/libgfortran/generated/matmul_i4.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_i4 (gfc_array_i4 * retarray, gfc_array_i4 * a, gfc_array_i4 * b) +{ + GFC_INTEGER_4 *abase; + GFC_INTEGER_4 *bbase; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_INTEGER_4 *pa; + GFC_INTEGER_4 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c new file mode 100644 index 00000000000..1ca78276478 --- /dev/null +++ b/libgfortran/generated/matmul_i8.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_i8 (gfc_array_i8 * retarray, gfc_array_i8 * a, gfc_array_i8 * b) +{ + GFC_INTEGER_8 *abase; + GFC_INTEGER_8 *bbase; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_INTEGER_8 *pa; + GFC_INTEGER_8 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c new file mode 100644 index 00000000000..f141b651000 --- /dev/null +++ b/libgfortran/generated/matmul_l4.c @@ -0,0 +1,151 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_l4 (gfc_array_l4 * retarray, gfc_array_l4 * a, gfc_array_l4 * b) +{ + GFC_INTEGER_4 *abase; + GFC_INTEGER_4 *bbase; + GFC_LOGICAL_4 *dest; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_INTEGER_4 *pa; + GFC_INTEGER_4 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + abase = GFOR_POINTER_L8_TO_L4 (abase); + astride <<= 1; + } + bbase = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + bbase = GFOR_POINTER_L8_TO_L4 (bbase); + bstride <<= 1; + } + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + *dest = 0; + + for (n = 0; n < count; n++) + { + if (*pa && *pb) + { + *dest = 1; + break; + } + pa += astride; + pb += bstride; + } + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c new file mode 100644 index 00000000000..49243afd9ad --- /dev/null +++ b/libgfortran/generated/matmul_l8.c @@ -0,0 +1,151 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_l8 (gfc_array_l8 * retarray, gfc_array_l4 * a, gfc_array_l4 * b) +{ + GFC_INTEGER_4 *abase; + GFC_INTEGER_4 *bbase; + GFC_LOGICAL_8 *dest; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_INTEGER_4 *pa; + GFC_INTEGER_4 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + if (GFC_DESCRIPTOR_SIZE (a) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (a) == 8); + abase = GFOR_POINTER_L8_TO_L4 (abase); + astride <<= 1; + } + bbase = b->data; + if (GFC_DESCRIPTOR_SIZE (b) != 4) + { + assert (GFC_DESCRIPTOR_SIZE (b) == 8); + bbase = GFOR_POINTER_L8_TO_L4 (bbase); + bstride <<= 1; + } + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + *dest = 0; + + for (n = 0; n < count; n++) + { + if (*pa && *pb) + { + *dest = 1; + break; + } + pa += astride; + pb += bstride; + } + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c new file mode 100644 index 00000000000..dea706bb7d1 --- /dev/null +++ b/libgfortran/generated/matmul_r4.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_r4 (gfc_array_r4 * retarray, gfc_array_r4 * a, gfc_array_r4 * b) +{ + GFC_REAL_4 *abase; + GFC_REAL_4 *bbase; + GFC_REAL_4 *dest; + GFC_REAL_4 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_REAL_4 *pa; + GFC_REAL_4 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c new file mode 100644 index 00000000000..dfe4841615a --- /dev/null +++ b/libgfortran/generated/matmul_r8.c @@ -0,0 +1,138 @@ +/* Implementation of the MATMUL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +/* Dimensions: retarray(x,y) a(x, count) b(count,y). + Either a or b can be rank 1. In this case x or y is 1. */ +void +__matmul_r8 (gfc_array_r8 * retarray, gfc_array_r8 * a, gfc_array_r8 * b) +{ + GFC_REAL_8 *abase; + GFC_REAL_8 *bbase; + GFC_REAL_8 *dest; + GFC_REAL_8 res; + index_type rxstride; + index_type rystride; + index_type xcount; + index_type ycount; + index_type xstride; + index_type ystride; + index_type x; + index_type y; + + GFC_REAL_8 *pa; + GFC_REAL_8 *pb; + index_type astride; + index_type bstride; + index_type count; + index_type n; + + assert (GFC_DESCRIPTOR_RANK (a) == 2 + || GFC_DESCRIPTOR_RANK (b) == 2); + abase = a->data; + bbase = b->data; + dest = retarray->data; + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (a->dim[0].stride == 0) + a->dim[0].stride = 1; + if (b->dim[0].stride == 0) + b->dim[0].stride = 1; + + + if (GFC_DESCRIPTOR_RANK (retarray) == 1) + { + rxstride = retarray->dim[0].stride; + rystride = rxstride; + } + else + { + rxstride = retarray->dim[0].stride; + rystride = retarray->dim[1].stride; + } + + /* If we have rank 1 parameters, zero the absent stride, and set the size to + one. */ + if (GFC_DESCRIPTOR_RANK (a) == 1) + { + astride = a->dim[0].stride; + count = a->dim[0].ubound + 1 - a->dim[0].lbound; + xstride = 0; + rxstride = 0; + xcount = 1; + } + else + { + astride = a->dim[1].stride; + count = a->dim[1].ubound + 1 - a->dim[1].lbound; + xstride = a->dim[0].stride; + xcount = a->dim[0].ubound + 1 - a->dim[0].lbound; + } + if (GFC_DESCRIPTOR_RANK (b) == 1) + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = 0; + rystride = 0; + ycount = 1; + } + else + { + bstride = b->dim[0].stride; + assert(count == b->dim[0].ubound + 1 - b->dim[0].lbound); + ystride = b->dim[1].stride; + ycount = b->dim[1].ubound + 1 - b->dim[1].lbound; + } + + for (y = 0; y < ycount; y++) + { + for (x = 0; x < xcount; x++) + { + /* Do the summation for this element. For real and integer types + this is the same as DOT_PRODUCT. For complex types we use do + a*b, not conjg(a)*b. */ + pa = abase; + pb = bbase; + res = 0; + + for (n = 0; n < count; n++) + { + res += *pa * *pb; + pa += astride; + pb += bstride; + } + + *dest = res; + + dest += rxstride; + abase += xstride; + } + abase -= xstride * xcount; + bbase += ystride; + dest += rystride - (rxstride * xcount); + } +} + diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c new file mode 100644 index 00000000000..94f6f4f7080 --- /dev/null +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c new file mode 100644 index 00000000000..f5fb1ea55db --- /dev/null +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c new file mode 100644 index 00000000000..cb77fa6eeca --- /dev/null +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c new file mode 100644 index 00000000000..9491823b908 --- /dev/null +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c new file mode 100644 index 00000000000..c851bc408e9 --- /dev/null +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 maxval; + + maxval = -GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c new file mode 100644 index 00000000000..6a151a22073 --- /dev/null +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 maxval; + + maxval = -GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c new file mode 100644 index 00000000000..dc4d3b6cff5 --- /dev/null +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 maxval; + + maxval = -GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c new file mode 100644 index 00000000000..00525645460 --- /dev/null +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -0,0 +1,230 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 maxval; + + maxval = -GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base > maxval) + { + maxval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c new file mode 100644 index 00000000000..4f412099412 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c new file mode 100644 index 00000000000..f5dd241d7b7 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c new file mode 100644 index 00000000000..503cf6ad201 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c new file mode 100644 index 00000000000..08445db76e9 --- /dev/null +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c new file mode 100644 index 00000000000..5ec2525a9c2 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 maxval; + maxval = -GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c new file mode 100644 index 00000000000..8f7203b8654 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 maxval; + maxval = -GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c new file mode 100644 index 00000000000..2e80e4b3429 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 maxval; + maxval = -GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c new file mode 100644 index 00000000000..611ef048564 --- /dev/null +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -0,0 +1,266 @@ +/* Implementation of the MAXLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__maxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 maxval; + maxval = -GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > maxval) + { + maxval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c new file mode 100644 index 00000000000..78802553c25 --- /dev/null +++ b/libgfortran/generated/maxval_i4.c @@ -0,0 +1,255 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__maxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = -GFC_INTEGER_4_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = -GFC_INTEGER_4_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c new file mode 100644 index 00000000000..af433ea5dc2 --- /dev/null +++ b/libgfortran/generated/maxval_i8.c @@ -0,0 +1,255 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__maxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = -GFC_INTEGER_8_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = -GFC_INTEGER_8_HUGE; + if (len <= 0) + *dest = -GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c new file mode 100644 index 00000000000..3877b323b0f --- /dev/null +++ b/libgfortran/generated/maxval_r4.c @@ -0,0 +1,255 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__maxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_REAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_REAL_4 result; + src = base; + { + + result = -GFC_REAL_4_HUGE; + if (len <= 0) + *dest = -GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + + result = -GFC_REAL_4_HUGE; + if (len <= 0) + *dest = -GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c new file mode 100644 index 00000000000..b5c01062e6a --- /dev/null +++ b/libgfortran/generated/maxval_r8.c @@ -0,0 +1,255 @@ +/* Implementation of the MAXVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__maxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_REAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_REAL_8 result; + src = base; + { + + result = -GFC_REAL_8_HUGE; + if (len <= 0) + *dest = -GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + + result = -GFC_REAL_8_HUGE; + if (len <= 0) + *dest = -GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src > result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c new file mode 100644 index 00000000000..5407f4cb63c --- /dev/null +++ b/libgfortran/generated/minloc0_4_i4.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c new file mode 100644 index 00000000000..b0c58293eb8 --- /dev/null +++ b/libgfortran/generated/minloc0_4_i8.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c new file mode 100644 index 00000000000..175f9c8967b --- /dev/null +++ b/libgfortran/generated/minloc0_4_r4.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c new file mode 100644 index 00000000000..01f44a570f5 --- /dev/null +++ b/libgfortran/generated/minloc0_4_r8.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c new file mode 100644 index 00000000000..0d4410338d7 --- /dev/null +++ b/libgfortran/generated/minloc0_8_i4.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_4 minval; + + minval = GFC_INTEGER_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c new file mode 100644 index 00000000000..83ef0399dac --- /dev/null +++ b/libgfortran/generated/minloc0_8_i8.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_INTEGER_8 minval; + + minval = GFC_INTEGER_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c new file mode 100644 index 00000000000..36868e40333 --- /dev/null +++ b/libgfortran/generated/minloc0_8_r4.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_4 minval; + + minval = GFC_REAL_4_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c new file mode 100644 index 00000000000..5f0c48a68ae --- /dev/null +++ b/libgfortran/generated/minloc0_8_r8.c @@ -0,0 +1,230 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + + +void +__minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_REAL_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + } + } + } + } +} + +void +__mminloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS]; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type sstride[GFC_MAX_DIMENSIONS]; + index_type mstride[GFC_MAX_DIMENSIONS]; + index_type dstride; + GFC_INTEGER_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + index_type n; + + rank = GFC_DESCRIPTOR_RANK (array); + assert (rank > 0); + assert (GFC_DESCRIPTOR_RANK (retarray) == 1); + assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + assert (GFC_DESCRIPTOR_RANK (mask) == rank); + + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + dstride = retarray->dim[0].stride; + dest = retarray->data; + for (n = 0; n < rank; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + count[n] = 0; + if (extent[n] <= 0) + { + /* Set the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 0; + return; + } + } + + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + + /* Initialize the return value. */ + for (n = 0; n < rank; n++) + dest[n * dstride] = 1; + { + + GFC_REAL_8 minval; + + minval = GFC_REAL_8_HUGE; + + while (base) + { + { + /* Implementation start. */ + + if (*mbase && *base < minval) + { + minval = *base; + for (n = 0; n < rank; n++) + dest[n * dstride] = count[n] + 1; + } + /* Implementation end. */ + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the loop. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + } + } + } + } +} diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c new file mode 100644 index 00000000000..b3e56f0cc60 --- /dev/null +++ b/libgfortran/generated/minloc1_4_i4.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c new file mode 100644 index 00000000000..b2fce929561 --- /dev/null +++ b/libgfortran/generated/minloc1_4_i8.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c new file mode 100644 index 00000000000..d7f9ff6a627 --- /dev/null +++ b/libgfortran/generated/minloc1_4_r4.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c new file mode 100644 index 00000000000..66146ae5d8b --- /dev/null +++ b/libgfortran/generated/minloc1_4_r8.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_4 result; + src = base; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_4)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c new file mode 100644 index 00000000000..a5edad58492 --- /dev/null +++ b/libgfortran/generated/minloc1_8_i4.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_4 minval; + minval = GFC_INTEGER_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c new file mode 100644 index 00000000000..55f1ce268f0 --- /dev/null +++ b/libgfortran/generated/minloc1_8_i8.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_INTEGER_8 minval; + minval = GFC_INTEGER_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c new file mode 100644 index 00000000000..3f7eb16bf78 --- /dev/null +++ b/libgfortran/generated/minloc1_8_r4.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_4 minval; + minval = GFC_REAL_4_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c new file mode 100644 index 00000000000..19cb41d7acc --- /dev/null +++ b/libgfortran/generated/minloc1_8_r8.c @@ -0,0 +1,266 @@ +/* Implementation of the MINLOC intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include <limits.h> +#include "libgfortran.h" + + +void +__minloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + GFC_REAL_8 minval; + minval = GFC_REAL_8_HUGE; + result = 1; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < minval) + { + minval = *src; + result = (GFC_INTEGER_8)n + 1; + } + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c new file mode 100644 index 00000000000..0bd7f5698c1 --- /dev/null +++ b/libgfortran/generated/minval_i4.c @@ -0,0 +1,255 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__minval_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = GFC_INTEGER_4_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = GFC_INTEGER_4_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c new file mode 100644 index 00000000000..7f686f33658 --- /dev/null +++ b/libgfortran/generated/minval_i8.c @@ -0,0 +1,255 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__minval_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = GFC_INTEGER_8_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = GFC_INTEGER_8_HUGE; + if (len <= 0) + *dest = GFC_INTEGER_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c new file mode 100644 index 00000000000..2ea19e451d3 --- /dev/null +++ b/libgfortran/generated/minval_r4.c @@ -0,0 +1,255 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__minval_r4 (gfc_array_r4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_REAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_REAL_4 result; + src = base; + { + + result = GFC_REAL_4_HUGE; + if (len <= 0) + *dest = GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + + result = GFC_REAL_4_HUGE; + if (len <= 0) + *dest = GFC_REAL_4_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c new file mode 100644 index 00000000000..4ed8ce1d0aa --- /dev/null +++ b/libgfortran/generated/minval_r8.c @@ -0,0 +1,255 @@ +/* Implementation of the MINVAL intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include <float.h> +#include "libgfortran.h" + + +void +__minval_r8 (gfc_array_r8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_REAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_REAL_8 result; + src = base; + { + + result = GFC_REAL_8_HUGE; + if (len <= 0) + *dest = GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta) + { + + if (*src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + + result = GFC_REAL_8_HUGE; + if (len <= 0) + *dest = GFC_REAL_8_HUGE; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc && *src < result) + result = *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/nearest_r4.c b/libgfortran/generated/nearest_r4.c new file mode 100644 index 00000000000..cafc02f21f2 --- /dev/null +++ b/libgfortran/generated/nearest_r4.c @@ -0,0 +1,38 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include <float.h> +#include "libgfortran.h" + + +GFC_REAL_4 +prefix(nearest_r4) (GFC_REAL_4 s, GFC_REAL_4 dir) +{ + dir = copysignf (__builtin_inff (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_4 r = nextafterf (s, dir); + return r; + } + else + return nextafterf (s, dir); +} diff --git a/libgfortran/generated/nearest_r8.c b/libgfortran/generated/nearest_r8.c new file mode 100644 index 00000000000..54a374546df --- /dev/null +++ b/libgfortran/generated/nearest_r8.c @@ -0,0 +1,38 @@ +/* Implementation of the NEAREST intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include <float.h> +#include "libgfortran.h" + + +GFC_REAL_8 +prefix(nearest_r8) (GFC_REAL_8 s, GFC_REAL_8 dir) +{ + dir = copysign (__builtin_inf (), dir); + if (FLT_EVAL_METHOD != 0) + { + /* ??? Work around glibc bug on x86. */ + volatile GFC_REAL_8 r = nextafter (s, dir); + return r; + } + else + return nextafter (s, dir); +} diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c new file mode 100644 index 00000000000..b12a047d7a6 --- /dev/null +++ b/libgfortran/generated/product_c4.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_4 *base; + GFC_COMPLEX_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_4 *src; + GFC_COMPLEX_4 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_4 *dest; + GFC_COMPLEX_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_4 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c new file mode 100644 index 00000000000..6e88972109a --- /dev/null +++ b/libgfortran/generated/product_c8.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_c8 (gfc_array_c8 * retarray, gfc_array_c8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_8 *base; + GFC_COMPLEX_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_8 *src; + GFC_COMPLEX_8 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_8 *dest; + GFC_COMPLEX_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_8 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c new file mode 100644 index 00000000000..229087f6941 --- /dev/null +++ b/libgfortran/generated/product_i4.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c new file mode 100644 index 00000000000..16ef0a05b3c --- /dev/null +++ b/libgfortran/generated/product_i8.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c new file mode 100644 index 00000000000..5761b2ed86d --- /dev/null +++ b/libgfortran/generated/product_r4.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_r4 (gfc_array_r4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_REAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_REAL_4 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c new file mode 100644 index 00000000000..d00c970e61f --- /dev/null +++ b/libgfortran/generated/product_r8.c @@ -0,0 +1,253 @@ +/* Implementation of the PRODUCT intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__product_r8 (gfc_array_r8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_REAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_REAL_8 result; + src = base; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + + result = 1; + if (len <= 0) + *dest = 1; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result *= *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/reshape_i4.c b/libgfortran/generated/reshape_i4.c new file mode 100644 index 00000000000..7da866cf5d0 --- /dev/null +++ b/libgfortran/generated/reshape_i4.c @@ -0,0 +1,225 @@ +/* Implementation of the RESHAPE + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + +/* The shape parameter is ignored. We can currently deduce the shape from the + return array. */ +void +__reshape_4 (gfc_array_i4 * ret, gfc_array_i4 * source, shape_type * shape, + gfc_array_i4 * pad, shape_type * order) +{ + /* r.* indicates the return array. */ + index_type rcount[GFC_MAX_DIMENSIONS - 1]; + index_type rextent[GFC_MAX_DIMENSIONS - 1]; + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type rdim; + index_type rsize; + GFC_INTEGER_4 *rptr; + /* s.* indicates the source array. */ + index_type scount[GFC_MAX_DIMENSIONS - 1]; + index_type sextent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type sdim; + index_type ssize; + const GFC_INTEGER_4 *sptr; + /* p.* indicates the pad array. */ + index_type pcount[GFC_MAX_DIMENSIONS - 1]; + index_type pextent[GFC_MAX_DIMENSIONS - 1]; + index_type pstride[GFC_MAX_DIMENSIONS - 1]; + index_type pdim; + index_type psize; + const GFC_INTEGER_4 *pptr; + + const GFC_INTEGER_4 *src; + int n; + int dim; + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + if (shape->dim[0].stride == 0) + shape->dim[0].stride = 1; + if (pad && pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + if (order && order->dim[0].stride == 0) + order->dim[0].stride = 1; + + rdim = GFC_DESCRIPTOR_RANK (ret); + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * order->dim[0].stride] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = ret->dim[dim].stride; + rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + + if (rextent[n] != shape->data[dim * shape->dim[0].stride]) + runtime_error ("shape and target do not conform"); + + if (rsize == rstride[n]) + rsize *= rextent[n]; + else + rsize = 0; + if (rextent[dim] <= 0) + return; + } + + sdim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = source->dim[n].stride; + sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (sextent[n] <= 0) + abort (); + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (pad) + { + if (pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + abort (); + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pptr = NULL; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= 4; + ssize *= 4; + psize *= 4; + reshape_packed ((char *)ret->data, rsize, (char *)source->data, + ssize, pad ? (char *)pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0]; + sstride0 = sstride[0]; + + while (rptr) + { + /* Select between the source and pad arrays. */ + *rptr = *src; + /* Advance to the next element. */ + rptr += rstride0; + src += sstride0; + rcount[0]++; + scount[0]++; + /* Advance to the next destination element. */ + n = 0; + while (rcount[n] == rextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + rcount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * rextent[n]; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n]; + } + } + /* Advance to the next source element. */ + n = 0; + while (scount[n] == sextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + scount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= sstride[n] * sextent[n]; + n++; + if (n == sdim) + { + if (sptr && pad) + { + /* Switch to the pad array. */ + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0]; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/reshape_i8.c b/libgfortran/generated/reshape_i8.c new file mode 100644 index 00000000000..f4e40197d82 --- /dev/null +++ b/libgfortran/generated/reshape_i8.c @@ -0,0 +1,225 @@ +/* Implementation of the RESHAPE + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type; + +/* The shape parameter is ignored. We can currently deduce the shape from the + return array. */ +void +__reshape_8 (gfc_array_i8 * ret, gfc_array_i8 * source, shape_type * shape, + gfc_array_i8 * pad, shape_type * order) +{ + /* r.* indicates the return array. */ + index_type rcount[GFC_MAX_DIMENSIONS - 1]; + index_type rextent[GFC_MAX_DIMENSIONS - 1]; + index_type rstride[GFC_MAX_DIMENSIONS - 1]; + index_type rstride0; + index_type rdim; + index_type rsize; + GFC_INTEGER_8 *rptr; + /* s.* indicates the source array. */ + index_type scount[GFC_MAX_DIMENSIONS - 1]; + index_type sextent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type sstride0; + index_type sdim; + index_type ssize; + const GFC_INTEGER_8 *sptr; + /* p.* indicates the pad array. */ + index_type pcount[GFC_MAX_DIMENSIONS - 1]; + index_type pextent[GFC_MAX_DIMENSIONS - 1]; + index_type pstride[GFC_MAX_DIMENSIONS - 1]; + index_type pdim; + index_type psize; + const GFC_INTEGER_8 *pptr; + + const GFC_INTEGER_8 *src; + int n; + int dim; + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + if (shape->dim[0].stride == 0) + shape->dim[0].stride = 1; + if (pad && pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + if (order && order->dim[0].stride == 0) + order->dim[0].stride = 1; + + rdim = GFC_DESCRIPTOR_RANK (ret); + rsize = 1; + for (n = 0; n < rdim; n++) + { + if (order) + dim = order->data[n * order->dim[0].stride] - 1; + else + dim = n; + + rcount[n] = 0; + rstride[n] = ret->dim[dim].stride; + rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound; + + if (rextent[n] != shape->data[dim * shape->dim[0].stride]) + runtime_error ("shape and target do not conform"); + + if (rsize == rstride[n]) + rsize *= rextent[n]; + else + rsize = 0; + if (rextent[dim] <= 0) + return; + } + + sdim = GFC_DESCRIPTOR_RANK (source); + ssize = 1; + for (n = 0; n < sdim; n++) + { + scount[n] = 0; + sstride[n] = source->dim[n].stride; + sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound; + if (sextent[n] <= 0) + abort (); + + if (ssize == sstride[n]) + ssize *= sextent[n]; + else + ssize = 0; + } + + if (pad) + { + if (pad->dim[0].stride == 0) + pad->dim[0].stride = 1; + pdim = GFC_DESCRIPTOR_RANK (pad); + psize = 1; + for (n = 0; n < pdim; n++) + { + pcount[n] = 0; + pstride[n] = pad->dim[n].stride; + pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound; + if (pextent[n] <= 0) + abort (); + if (psize == pstride[n]) + psize *= pextent[n]; + else + psize = 0; + } + pptr = pad->data; + } + else + { + pdim = 0; + psize = 1; + pptr = NULL; + } + + if (rsize != 0 && ssize != 0 && psize != 0) + { + rsize *= 8; + ssize *= 8; + psize *= 8; + reshape_packed ((char *)ret->data, rsize, (char *)source->data, + ssize, pad ? (char *)pad->data : NULL, psize); + return; + } + rptr = ret->data; + src = sptr = source->data; + rstride0 = rstride[0]; + sstride0 = sstride[0]; + + while (rptr) + { + /* Select between the source and pad arrays. */ + *rptr = *src; + /* Advance to the next element. */ + rptr += rstride0; + src += sstride0; + rcount[0]++; + scount[0]++; + /* Advance to the next destination element. */ + n = 0; + while (rcount[n] == rextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + rcount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + rptr -= rstride[n] * rextent[n]; + n++; + if (n == rdim) + { + /* Break out of the loop. */ + rptr = NULL; + break; + } + else + { + rcount[n]++; + rptr += rstride[n]; + } + } + /* Advance to the next source element. */ + n = 0; + while (scount[n] == sextent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + scount[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + src -= sstride[n] * sextent[n]; + n++; + if (n == sdim) + { + if (sptr && pad) + { + /* Switch to the pad array. */ + sptr = NULL; + sdim = pdim; + for (dim = 0; dim < pdim; dim++) + { + scount[dim] = pcount[dim]; + sextent[dim] = pextent[dim]; + sstride[dim] = pstride[dim]; + sstride0 = sstride[0]; + } + } + /* We now start again from the beginning of the pad array. */ + src = pptr; + break; + } + else + { + scount[n]++; + src += sstride[n]; + } + } + } +} + diff --git a/libgfortran/generated/set_exponent_r4.c b/libgfortran/generated/set_exponent_r4.c new file mode 100644 index 00000000000..32717e22305 --- /dev/null +++ b/libgfortran/generated/set_exponent_r4.c @@ -0,0 +1,30 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_REAL_4 +prefix(set_exponent_r4) (GFC_REAL_4 s, GFC_INTEGER_4 i) +{ + int dummy_exp; + return scalbnf (frexpf (s, &dummy_exp), i); +} diff --git a/libgfortran/generated/set_exponent_r8.c b/libgfortran/generated/set_exponent_r8.c new file mode 100644 index 00000000000..ad2a97d837b --- /dev/null +++ b/libgfortran/generated/set_exponent_r8.c @@ -0,0 +1,30 @@ +/* Implementation of the SET_EXPONENT intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Richard Henderson <rth@redhat.com>. + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +GFC_REAL_8 +prefix(set_exponent_r8) (GFC_REAL_8 s, GFC_INTEGER_4 i) +{ + int dummy_exp; + return scalbn (frexp (s, &dummy_exp), i); +} diff --git a/libgfortran/generated/shape_i4.c b/libgfortran/generated/shape_i4.c new file mode 100644 index 00000000000..03446912f61 --- /dev/null +++ b/libgfortran/generated/shape_i4.c @@ -0,0 +1,43 @@ +/* Implementation of the SHAPE intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +void +__shape_4 (gfc_array_i4 * ret, const gfc_array_i4 * array) +{ + int n; + index_type stride; + + stride = ret->dim[0].stride; + if (stride == 0) + stride = 1; + + for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + { + ret->data[n * stride] = + array->dim[n].ubound + 1 - array->dim[n].lbound; + } +} + diff --git a/libgfortran/generated/shape_i8.c b/libgfortran/generated/shape_i8.c new file mode 100644 index 00000000000..bd7490016ae --- /dev/null +++ b/libgfortran/generated/shape_i8.c @@ -0,0 +1,43 @@ +/* Implementation of the SHAPE intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + +void +__shape_8 (gfc_array_i8 * ret, const gfc_array_i8 * array) +{ + int n; + index_type stride; + + stride = ret->dim[0].stride; + if (stride == 0) + stride = 1; + + for (n = 0; n < GFC_DESCRIPTOR_RANK (array); n++) + { + ret->data[n * stride] = + array->dim[n].ubound + 1 - array->dim[n].lbound; + } +} + diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c new file mode 100644 index 00000000000..a6e05b2a4c9 --- /dev/null +++ b/libgfortran/generated/sum_c4.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_c4 (gfc_array_c4 * retarray, gfc_array_c4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_4 *base; + GFC_COMPLEX_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_4 *src; + GFC_COMPLEX_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_4 *dest; + GFC_COMPLEX_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c new file mode 100644 index 00000000000..f65002a091b --- /dev/null +++ b/libgfortran/generated/sum_c8.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_c8 (gfc_array_c8 * retarray, gfc_array_c8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_8 *base; + GFC_COMPLEX_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_COMPLEX_8 *src; + GFC_COMPLEX_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_COMPLEX_8 *dest; + GFC_COMPLEX_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_COMPLEX_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_COMPLEX_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c new file mode 100644 index 00000000000..a15e0d4804f --- /dev/null +++ b/libgfortran/generated/sum_i4.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *base; + GFC_INTEGER_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_4 *src; + GFC_INTEGER_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_4 *dest; + GFC_INTEGER_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c new file mode 100644 index 00000000000..2ad5f4ac822 --- /dev/null +++ b/libgfortran/generated/sum_i8.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *base; + GFC_INTEGER_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_INTEGER_8 *src; + GFC_INTEGER_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_INTEGER_8 *dest; + GFC_INTEGER_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_INTEGER_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_INTEGER_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c new file mode 100644 index 00000000000..3b637183256 --- /dev/null +++ b/libgfortran/generated/sum_r4.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_r4 (gfc_array_r4 * retarray, gfc_array_r4 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *base; + GFC_REAL_4 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_4 *src; + GFC_REAL_4 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_4 *dest; + GFC_REAL_4 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_4 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_4 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c new file mode 100644 index 00000000000..3aa550bbe8f --- /dev/null +++ b/libgfortran/generated/sum_r8.c @@ -0,0 +1,252 @@ +/* Implementation of the SUM intrinsic + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <stdlib.h> +#include <assert.h> +#include "libgfortran.h" + + +void +__sum_r8 (gfc_array_r8 * retarray, gfc_array_r8 *array, index_type *pdim) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *base; + GFC_REAL_8 *dest; + index_type rank; + index_type n; + index_type len; + index_type delta; + index_type dim; + + /* Make dim zero based to avoid confusion. */ + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + delta = array->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + len = 0; + } + + base = array->data; + dest = retarray->data; + + while (base) + { + GFC_REAL_8 *src; + GFC_REAL_8 result; + src = base; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta) + { + + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + dest += dstride[n]; + } + } + } +} + +void +__msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, index_type *pdim, gfc_array_l4 * mask) +{ + index_type count[GFC_MAX_DIMENSIONS - 1]; + index_type extent[GFC_MAX_DIMENSIONS - 1]; + index_type sstride[GFC_MAX_DIMENSIONS - 1]; + index_type dstride[GFC_MAX_DIMENSIONS - 1]; + index_type mstride[GFC_MAX_DIMENSIONS - 1]; + GFC_REAL_8 *dest; + GFC_REAL_8 *base; + GFC_LOGICAL_4 *mbase; + int rank; + int dim; + index_type n; + index_type len; + index_type delta; + index_type mdelta; + + dim = (*pdim) - 1; + rank = GFC_DESCRIPTOR_RANK (array) - 1; + assert (rank == GFC_DESCRIPTOR_RANK (retarray)); + if (array->dim[0].stride == 0) + array->dim[0].stride = 1; + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; + if (len <= 0) + return; + delta = array->dim[dim].stride; + mdelta = mask->dim[dim].stride; + + for (n = 0; n < dim; n++) + { + sstride[n] = array->dim[n].stride; + mstride[n] = mask->dim[n].stride; + extent[n] = array->dim[n].ubound + 1 - array->dim[n].lbound; + } + for (n = dim; n < rank; n++) + { + sstride[n] = array->dim[n + 1].stride; + mstride[n] = mask->dim[n + 1].stride; + extent[n] = + array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; + } + + for (n = 0; n < rank; n++) + { + count[n] = 0; + dstride[n] = retarray->dim[n].stride; + if (extent[n] <= 0) + return; + } + + dest = retarray->data; + base = array->data; + mbase = mask->data; + + if (GFC_DESCRIPTOR_SIZE (mask) != 4) + { + /* This allows the same loop to be used for all logical types. */ + assert (GFC_DESCRIPTOR_SIZE (mask) == 8); + for (n = 0; n < rank; n++) + mstride[n] <<= 1; + mdelta <<= 1; + mbase = (GFOR_POINTER_L8_TO_L4 (mbase)); + } + + while (base) + { + GFC_REAL_8 *src; + GFC_LOGICAL_4 *msrc; + GFC_REAL_8 result; + src = base; + msrc = mbase; + { + + result = 0; + if (len <= 0) + *dest = 0; + else + { + for (n = 0; n < len; n++, src += delta, msrc += mdelta) + { + + if (*msrc) + result += *src; + } + *dest = result; + } + } + /* Advance to the next element. */ + count[0]++; + base += sstride[0]; + mbase += mstride[0]; + dest += dstride[0]; + n = 0; + while (count[n] == extent[n]) + { + /* When we get to the end of a dimension, reset it and increment + the next dimension. */ + count[n] = 0; + /* We could precalculate these products, but this is a less + frequently used path so proabably not worth it. */ + base -= sstride[n] * extent[n]; + mbase -= mstride[n] * extent[n]; + dest -= dstride[n] * extent[n]; + n++; + if (n == rank) + { + /* Break out of the look. */ + base = NULL; + break; + } + else + { + count[n]++; + base += sstride[n]; + mbase += mstride[n]; + dest += dstride[n]; + } + } + } +} diff --git a/libgfortran/generated/transpose_i4.c b/libgfortran/generated/transpose_i4.c new file mode 100644 index 00000000000..184243f21d4 --- /dev/null +++ b/libgfortran/generated/transpose_i4.c @@ -0,0 +1,69 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <assert.h> +#include "libgfortran.h" + +void +__transpose_4 (gfc_array_i4 * ret, gfc_array_i4 * source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_4 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_INTEGER_4 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } +} diff --git a/libgfortran/generated/transpose_i8.c b/libgfortran/generated/transpose_i8.c new file mode 100644 index 00000000000..2dcaa000889 --- /dev/null +++ b/libgfortran/generated/transpose_i8.c @@ -0,0 +1,69 @@ +/* Implementation of the TRANSPOSE intrinsic + Copyright 2003 Free Software Foundation, Inc. + Contributed by Tobias Schlüter + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfor is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Ligbfor is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include <assert.h> +#include "libgfortran.h" + +void +__transpose_8 (gfc_array_i8 * ret, gfc_array_i8 * source) +{ + /* r.* indicates the return array. */ + index_type rxstride, rystride; + GFC_INTEGER_8 *rptr; + /* s.* indicates the source array. */ + index_type sxstride, systride; + const GFC_INTEGER_8 *sptr; + + index_type xcount, ycount; + index_type x, y; + + assert (GFC_DESCRIPTOR_RANK (source) == 2); + + if (ret->dim[0].stride == 0) + ret->dim[0].stride = 1; + if (source->dim[0].stride == 0) + source->dim[0].stride = 1; + + sxstride = source->dim[0].stride; + systride = source->dim[1].stride; + xcount = source->dim[0].ubound + 1 - source->dim[0].lbound; + ycount = source->dim[1].ubound + 1 - source->dim[1].lbound; + + rxstride = ret->dim[0].stride; + rystride = ret->dim[1].stride; + + rptr = ret->data; + sptr = source->data; + + for (y=0; y < ycount; y++) + { + for (x=0; x < xcount; x++) + { + *rptr = *sptr; + + sptr += sxstride; + rptr += rystride; + } + sptr += systride - (sxstride * xcount); + rptr += rxstride - (rystride * xcount); + } +} diff --git a/libgfortran/generated/trig_c4.c b/libgfortran/generated/trig_c4.c new file mode 100644 index 00000000000..14d12c40144 --- /dev/null +++ b/libgfortran/generated/trig_c4.c @@ -0,0 +1,71 @@ +/* Complex trig functions + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* Complex number z = a + ib. */ + +/* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */ +GFC_COMPLEX_4 +csinf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 r; + GFC_REAL_4 i; + GFC_COMPLEX_4 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sinf (r) * coshf (i), cosf (r) * sinhf (i)); + return v; +} + +/* cos(z) = cos(a)cosh(b) - isin(a)sinh(b) */ +GFC_COMPLEX_4 +ccosf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 r; + GFC_REAL_4 i; + GFC_COMPLEX_4 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cosf (r) * coshf (i), - (sinf (r) * sinhf (i))); + return v; +} + +/* tan(z) = (tan(a) + itanh(b)) / (1 - itan(a)tanh(b)) */ +GFC_COMPLEX_4 +ctanf (GFC_COMPLEX_4 a) +{ + GFC_REAL_4 rt; + GFC_REAL_4 it; + GFC_COMPLEX_4 n; + GFC_COMPLEX_4 d; + + rt = tanf (REALPART (a)); + it = tanhf (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d , 1, - (rt * it)); + + return n / d; +} + diff --git a/libgfortran/generated/trig_c8.c b/libgfortran/generated/trig_c8.c new file mode 100644 index 00000000000..cea4872bdfc --- /dev/null +++ b/libgfortran/generated/trig_c8.c @@ -0,0 +1,71 @@ +/* Complex trig functions + Copyright 2002 Free Software Foundation, Inc. + Contributed by Paul Brook <paul@nowt.org> + +This file is part of the GNU Fortran 95 runtime library (libgfor). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with libgfor; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ +#include <math.h> +#include "libgfortran.h" + + +/* Complex number z = a + ib. */ + +/* sin(z) = sin(a)cosh(b) + icos(a)sinh(b) */ +GFC_COMPLEX_8 +csin (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 r; + GFC_REAL_8 i; + GFC_COMPLEX_8 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, sin (r) * cosh (i), cos (r) * sinh (i)); + return v; +} + +/* cos(z) = cos(a)cosh(b) - isin(a)sinh(b) */ +GFC_COMPLEX_8 +ccos (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 r; + GFC_REAL_8 i; + GFC_COMPLEX_8 v; + + r = REALPART (a); + i = IMAGPART (a); + COMPLEX_ASSIGN (v, cos (r) * cosh (i), - (sin (r) * sinh (i))); + return v; +} + +/* tan(z) = (tan(a) + itanh(b)) / (1 - itan(a)tanh(b)) */ +GFC_COMPLEX_8 +ctan (GFC_COMPLEX_8 a) +{ + GFC_REAL_8 rt; + GFC_REAL_8 it; + GFC_COMPLEX_8 n; + GFC_COMPLEX_8 d; + + rt = tan (REALPART (a)); + it = tanh (IMAGPART (a)); + COMPLEX_ASSIGN (n, rt, it); + COMPLEX_ASSIGN (d , 1, - (rt * it)); + + return n / d; +} + |