diff -uNr dis45.ORIG/2.04/Imakefile dis45/2.04/Imakefile --- dis45.ORIG/2.04/Imakefile 1999-05-13 07:29:15.000000000 +0900 +++ dis45/2.04/Imakefile 2005-11-28 15:51:53.000000000 +0900 @@ -27,6 +27,10 @@ OBJ = $(OBJ1) $(OBJ2) $(OBJ3) +ifeq ($(shell uname -s),Darwin) +OBJ += darwinadd.o myfnum.o +endif + /* Libraries */ SYS_LIBRARIES = $(CERN_LNK) $(COM_CLI_LNK) $(SYS_LIB) @@ -112,3 +116,11 @@ clean:: $(RM) CERNLIB_SHARED_HBOOK_OBJ #endif + +GCCVER = $(shell gcc --version | grep gcc | sed -e 's;gcc [^0-9]*\([0-9]*\.[0-9]*\.[0-9]*\) .*;\1;') +OSVER = $(shell uname -r) + +darwinadd.o: darwinadd.c + $(CC) $(CFLAGS) -I/usr/local/include/c++/$(GCCVER)/powerpc-apple-darwin$(OSVER) \ + -I/usr/local/include/c++/$(GCCVER)/powerpc-apple-darwin$(OSVER)/bits \ + -o $@ -c $? diff -uNr dis45.ORIG/2.04/Imakefile.def dis45/2.04/Imakefile.def --- dis45.ORIG/2.04/Imakefile.def 2005-11-14 23:30:18.000000000 +0900 +++ dis45/2.04/Imakefile.def 2005-11-28 15:52:59.000000000 +0900 @@ -14,19 +14,32 @@ ADSOFT = /adsoft /* COM + CLI [+ readline] link option */ +#if 0 COM_CLI_LNK = \ -L${ADSOFT}/com_cli/2.04/${EXT} -lCOM -lCLI /adsoft/readline/5.0/${EXT}/libreadline.a -ltermcap +#else +COM_CLI_LNK = \ +-L../../com_cli/2.04/com -lCOM -L../../com_cli/2.04/cli -lCLI -L/usr/local/lib -lreadline -ltermcap +#endif /* CERN libraries link option */ +#if 0 CERN_DIR = ${ADSOFT}/cern/v2002/${EXT} CERN_LNK = \ -L${CERN_DIR} -lgraflib -lgrafX11 -lpacklib -lkernlib -lmathlib ${XLIB} +#else +CERN_DIR = /cern/pro +CERN_LNK = \ +-L${CERN_DIR}/lib -lgraflib -lgrafX11 -lpacklib -lkernlib -lmathlib ${XLIB} +#endif /* select CORRECT hpl.inc according to the cernlib version */ HPL_INC = hpl-v98.inc /* hpl-v94a.inc hpl-v98.inc */ /* comment out for other versions of cernlib */ +#if 0 #define CERNLIB_v98_FIX_OBJ hpltab.o igcell.o /* fixed code */ #define CERNLIB_SHARED_HBOOK_OBJ hcreatem.o hlimap.o hmapm.o hmmap.o locf.o /* shared hbook with mmap() */ +#endif /* path to install binaries */ INSTALL_DIR = ${TOP}/${EXT} @@ -119,9 +132,15 @@ #define HPK_Fortran_Source_Files hpkdummy.f #define HROPEN_INC hropen-ok.inc CC = gcc +ifeq ($(shell which gfortran | grep -vc 'no gfortran'),1) +FC = gfortran +FFLAGS = -g -fno-second-underscore -I. +SYS_LIB = -flat_namespace /usr/local/lib/libgfortran.a +else FC = g77 FFLAGS = -g -fno-second-underscore -fno-f2c SYS_LIB = -flat_namespace -lcc_dynamic -ldl +endif INSTALLFLAGS = -c #endif diff -uNr dis45.ORIG/2.04/c99_protos.h dis45/2.04/c99_protos.h --- dis45.ORIG/2.04/c99_protos.h 2005-11-28 15:38:13.000000000 +0900 +++ dis45/2.04/c99_protos.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,407 @@ +/* Declarations of various C99 functions + Copyright (C) 2004 Free Software Foundation, Inc. + +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. + +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 libgfortran; see the file COPYING.LIB. If not, +write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* As a special exception, if you link this library with other files, + some of which are compiled with GCC, to produce an executable, + this library does not by itself cause the resulting executable + to be covered by the GNU General Public License. + This exception does not however invalidate any other reasons why + the executable file might be covered by the GNU General Public License. */ + + +#ifndef C99_PROTOS_H +#define C99_PROTOS_H 1 + +/* float variants of libm functions */ +#ifndef HAVE_ACOSF +#define HAVE_ACOSF 1 +extern float acosf(float); +#endif + +#ifndef HAVE_ACOSHF +#define HAVE_ACOSHF 1 +extern float acoshf(float); +#endif + +#ifndef HAVE_ASINF +#define HAVE_ASINF 1 +extern float asinf(float); +#endif + +#ifndef HAVE_ASINHF +#define HAVE_ASINHF 1 +extern float asinhf(float); +#endif + +#ifndef HAVE_ATAN2F +#define HAVE_ATAN2F 1 +extern float atan2f(float, float); +#endif + +#ifndef HAVE_ATANF +#define HAVE_ATANF 1 +extern float atanf(float); +#endif + +#ifndef HAVE_ATANHF +#define HAVE_ATANHF 1 +extern float atanhf(float); +#endif + +#ifndef HAVE_CEILF +#define HAVE_CEILF 1 +extern float ceilf(float); +#endif + +#ifndef HAVE_COPYSIGNF +#define HAVE_COPYSIGNF 1 +extern float copysignf(float, float); +#endif + +#ifndef HAVE_COSF +#define HAVE_COSF 1 +extern float cosf(float); +#endif + +#ifndef HAVE_COSHF +#define HAVE_COSHF 1 +extern float coshf(float); +#endif + +#ifndef HAVE_EXPF +#define HAVE_EXPF 1 +extern float expf(float); +#endif + +#ifndef HAVE_FABSF +#define HAVE_FABSF 1 +extern float fabsf(float); +#endif + +#ifndef HAVE_FLOORF +#define HAVE_FLOORF 1 +extern float floorf(float); +#endif + +#ifndef HAVE_FREXPF +#define HAVE_FREXPF 1 +extern float frexpf(float, int *); +#endif + +#ifndef HAVE_HYPOTF +#define HAVE_HYPOTF 1 +extern float hypotf(float, float); +#endif + +#ifndef HAVE_LOGF +#define HAVE_LOGF 1 +extern float logf(float); +#endif + +#ifndef HAVE_LOG10F +#define HAVE_LOG10F 1 +extern float log10f(float); +#endif + +#ifndef HAVE_SCALBN +#define HAVE_SCALBN 1 +extern double scalbn(double, int); +#endif + +#ifndef HAVE_SCALBNF +#define HAVE_SCALBNF 1 +extern float scalbnf(float, int); +#endif + +#ifndef HAVE_SINF +#define HAVE_SINF 1 +extern float sinf(float); +#endif + +#ifndef HAVE_SINHF +#define HAVE_SINHF 1 +extern float sinhf(float); +#endif + +#ifndef HAVE_SQRTF +#define HAVE_SQRTF 1 +extern float sqrtf(float); +#endif + +#ifndef HAVE_TANF +#define HAVE_TANF 1 +extern float tanf(float); +#endif + +#ifndef HAVE_TANHF +#define HAVE_TANHF 1 +extern float tanhf(float); +#endif + +#ifndef HAVE_TRUNC +#define HAVE_TRUNC 1 +extern double trunc(double); +#endif + +#ifndef HAVE_TRUNCF +#define HAVE_TRUNCF 1 +extern float truncf(float); +#endif + +#ifndef HAVE_NEXTAFTERF +#define HAVE_NEXTAFTERF 1 +extern float nextafterf(float, float); +#endif + +#ifndef HAVE_POWF +#define HAVE_POWF 1 +extern float powf(float, float); +#endif + +#ifndef HAVE_ROUND +#define HAVE_ROUND 1 +extern double round(double); +#endif + +#ifndef HAVE_ROUNDF +#define HAVE_ROUNDF 1 +extern float roundf(float); +#endif + + +/* log10l is needed on all platforms for decimal I/O */ +#ifndef HAVE_LOG10L +#define HAVE_LOG10L 1 +extern long double log10l(long double); +#endif + + +/* complex math functions */ + +#if !defined(HAVE_CABSF) +#define HAVE_CABSF 1 +extern float cabsf (float complex); +#endif + +#if !defined(HAVE_CABS) +#define HAVE_CABS 1 +extern double cabs (double complex); +#endif + +#if !defined(HAVE_CABSL) && defined(HAVE_HYPOTL) +#define HAVE_CABSL 1 +extern long double cabsl (long double complex); +#endif + + +#if !defined(HAVE_CARGF) +#define HAVE_CARGF 1 +extern float cargf (float complex); +#endif + +#if !defined(HAVE_CARG) +#define HAVE_CARG 1 +extern double carg (double complex); +#endif + +#if !defined(HAVE_CARGL) && defined(HAVE_ATAN2L) +#define HAVE_CARGL 1 +extern long double cargl (long double complex); +#endif + + +#if !defined(HAVE_CEXPF) +#define HAVE_CEXPF 1 +extern float complex cexpf (float complex); +#endif + +#if !defined(HAVE_CEXP) +#define HAVE_CEXP 1 +extern double complex cexp (double complex); +#endif + +#if !defined(HAVE_CEXPL) && defined(HAVE_COSL) && defined(HAVE_SINL) && defined(EXPL) +#define HAVE_CEXPL 1 +extern long double complex cexpl (long double complex); +#endif + + +#if !defined(HAVE_CLOGF) +#define HAVE_CLOGF 1 +extern float complex clogf (float complex); +#endif + +#if !defined(HAVE_CLOG) +#define HAVE_CLOG 1 +extern double complex clog (double complex); +#endif + +#if !defined(HAVE_CLOGL) && defined(HAVE_LOGL) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOGL 1 +extern long double complex clogl (long double complex); +#endif + + +#if !defined(HAVE_CLOG10F) +#define HAVE_CLOG10F 1 +extern float complex clog10f (float complex); +#endif + +#if !defined(HAVE_CLOG10) +#define HAVE_CLOG10 1 +extern double complex clog10 (double complex); +#endif + +#if !defined(HAVE_CLOG10L) && defined(HAVE_LOG10L) && defined(HAVE_CABSL) && defined(HAVE_CARGL) +#define HAVE_CLOG10L 1 +extern long double complex clog10l (long double complex); +#endif + + +#if !defined(HAVE_CPOWF) +#define HAVE_CPOWF 1 +extern float complex cpowf (float complex, float complex); +#endif + +#if !defined(HAVE_CPOW) +#define HAVE_CPOW 1 +extern double complex cpow (double complex, double complex); +#endif + +#if !defined(HAVE_CPOWL) && defined(HAVE_CEXPL) && defined(HAVE_CLOGL) +#define HAVE_CPOWL 1 +extern long double complex cpowl (long double complex, long double complex); +#endif + + +#if !defined(HAVE_CSQRTF) +#define HAVE_CSQRTF 1 +extern float complex csqrtf (float complex); +#endif + +#if !defined(HAVE_CSQRT) +#define HAVE_CSQRT 1 +extern double complex csqrt (double complex); +#endif + +#if !defined(HAVE_CSQRTL) && defined(HAVE_COPYSIGNL) && defined(HAVE_SQRTL) && defined(HAVE_FABSL) && defined(HAVE_HYPOTL) +#define HAVE_CSQRTL 1 +extern long double complex csqrtl (long double complex); +#endif + + +#if !defined(HAVE_CSINHF) +#define HAVE_CSINHF 1 +extern float complex csinhf (float complex); +#endif + +#if !defined(HAVE_CSINH) +#define HAVE_CSINH 1 +extern double complex csinh (double complex); +#endif + +#if !defined(HAVE_CSINHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINHL 1 +extern long double complex csinhl (long double complex); +#endif + + +#if !defined(HAVE_CCOSHF) +#define HAVE_CCOSHF 1 +extern float complex ccoshf (float complex); +#endif + +#if !defined(HAVE_CCOSH) +#define HAVE_CCOSH 1 +extern double complex ccosh (double complex); +#endif + +#if !defined(HAVE_CCOSHL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSHL 1 +extern long double complex ccoshl (long double complex); +#endif + + +#if !defined(HAVE_CTANHF) +#define HAVE_CTANHF 1 +extern float complex ctanhf (float complex); +#endif + +#if !defined(HAVE_CTANH) +#define HAVE_CTANH 1 +extern double complex ctanh (double complex); +#endif + +#if !defined(HAVE_CTANHL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANHL 1 +extern long double complex ctanhl (long double complex); +#endif + + +#if !defined(HAVE_CSINF) +#define HAVE_CSINF 1 +extern float complex csinf (float complex); +#endif + +#if !defined(HAVE_CSIN) +#define HAVE_CSIN 1 +extern double complex csin (double complex); +#endif + +#if !defined(HAVE_CSINL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CSINL 1 +extern long double complex csinl (long double complex); +#endif + + +#if !defined(HAVE_CCOSF) +#define HAVE_CCOSF 1 +extern float complex ccosf (float complex); +#endif + +#if !defined(HAVE_CCOS) +#define HAVE_CCOS 1 +extern double complex ccos (double complex); +#endif + +#if !defined(HAVE_CCOSL) && defined(HAVE_COSL) && defined(HAVE_COSHL) && defined(HAVE_SINL) && defined(HAVE_SINHL) +#define HAVE_CCOSL 1 +extern long double complex ccosl (long double complex); +#endif + + +#if !defined(HAVE_CTANF) +#define HAVE_CTANF 1 +extern float complex ctanf (float complex); +#endif + +#if !defined(HAVE_CTAN) +#define HAVE_CTAN 1 +extern double complex ctan (double complex); +#endif + +#if !defined(HAVE_CTANL) && defined(HAVE_TANL) && defined(HAVE_TANHL) +#define HAVE_CTANL 1 +extern long double complex ctanl (long double complex); +#endif + + +#endif /* C99_PROTOS_H */ + diff -uNr dis45.ORIG/2.04/config.h dis45/2.04/config.h --- dis45.ORIG/2.04/config.h 2005-11-28 15:38:19.000000000 +0900 +++ dis45/2.04/config.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,701 @@ +/* config.h. Generated by configure. */ +/* config.h.in. Generated from configure.ac by autoheader. */ + +/* Does gettimeofday take a single argument */ +/* #undef GETTIMEOFDAY_ONE_ARGUMENT */ + +/* libm includes acos */ +#define HAVE_ACOS 1 + +/* libm includes acosf */ +#define HAVE_ACOSF 1 + +/* libm includes acosh */ +#define HAVE_ACOSH 1 + +/* libm includes acoshf */ +#define HAVE_ACOSHF 1 + +/* libm includes acoshl */ +#define HAVE_ACOSHL 1 + +/* libm includes acosl */ +#define HAVE_ACOSL 1 + +/* Define to 1 if you have the `alarm' function. */ +#define HAVE_ALARM 1 + +/* libm includes asin */ +#define HAVE_ASIN 1 + +/* libm includes asinf */ +#define HAVE_ASINF 1 + +/* libm includes asinh */ +#define HAVE_ASINH 1 + +/* libm includes asinhf */ +#define HAVE_ASINHF 1 + +/* libm includes asinhl */ +#define HAVE_ASINHL 1 + +/* libm includes asinl */ +#define HAVE_ASINL 1 + +/* libm includes atan */ +#define HAVE_ATAN 1 + +/* libm includes atan2 */ +#define HAVE_ATAN2 1 + +/* libm includes atan2f */ +#define HAVE_ATAN2F 1 + +/* libm includes atan2l */ +#define HAVE_ATAN2L 1 + +/* libm includes atanf */ +#define HAVE_ATANF 1 + +/* libm includes atanh */ +#define HAVE_ATANH 1 + +/* libm includes atanhf */ +#define HAVE_ATANHF 1 + +/* libm includes atanhl */ +#define HAVE_ATANHL 1 + +/* libm includes atanl */ +#define HAVE_ATANL 1 + +/* Define to 1 if the target supports __attribute__((alias(...))). */ +/* #undef HAVE_ATTRIBUTE_ALIAS */ + +/* Define to 1 if the target supports __attribute__((dllexport)). */ +/* #undef HAVE_ATTRIBUTE_DLLEXPORT */ + +/* Define to 1 if the target supports __attribute__((visibility(...))). */ +#define HAVE_ATTRIBUTE_VISIBILITY 1 + +/* Define if fpclassify is broken. */ +/* #undef HAVE_BROKEN_FPCLASSIFY */ + +/* Define if isfinite is broken. */ +/* #undef HAVE_BROKEN_ISFINITE */ + +/* Define if isnan is broken. */ +/* #undef HAVE_BROKEN_ISNAN */ + +/* libm includes cabs */ +#define HAVE_CABS 1 + +/* libm includes cabsf */ +#define HAVE_CABSF 1 + +/* libm includes cabsl */ +#define HAVE_CABSL 1 + +/* libm includes carg */ +#define HAVE_CARG 1 + +/* libm includes cargf */ +#define HAVE_CARGF 1 + +/* libm includes cargl */ +#define HAVE_CARGL 1 + +/* libm includes ccos */ +#define HAVE_CCOS 1 + +/* libm includes ccosf */ +#define HAVE_CCOSF 1 + +/* libm includes ccosh */ +#define HAVE_CCOSH 1 + +/* libm includes ccoshf */ +#define HAVE_CCOSHF 1 + +/* libm includes ccoshl */ +#define HAVE_CCOSHL 1 + +/* libm includes ccosl */ +#define HAVE_CCOSL 1 + +/* libm includes ceil */ +#define HAVE_CEIL 1 + +/* libm includes ceilf */ +#define HAVE_CEILF 1 + +/* libm includes ceill */ +#define HAVE_CEILL 1 + +/* libm includes cexp */ +#define HAVE_CEXP 1 + +/* libm includes cexpf */ +#define HAVE_CEXPF 1 + +/* libm includes cexpl */ +#define HAVE_CEXPL 1 + +/* Define to 1 if you have the `chdir' function. */ +#define HAVE_CHDIR 1 + +/* Define to 1 if you have the `chsize' function. */ +/* #undef HAVE_CHSIZE */ + +/* libm includes clog */ +#define HAVE_CLOG 1 + +/* libm includes clog10 */ +/* #undef HAVE_CLOG10 */ + +/* libm includes clog10f */ +/* #undef HAVE_CLOG10F */ + +/* libm includes clog10l */ +/* #undef HAVE_CLOG10L */ + +/* libm includes clogf */ +#define HAVE_CLOGF 1 + +/* libm includes clogl */ +#define HAVE_CLOGL 1 + +/* complex.h exists */ +#define HAVE_COMPLEX_H 1 + +/* libm includes copysign */ +#define HAVE_COPYSIGN 1 + +/* libm includes copysignf */ +#define HAVE_COPYSIGNF 1 + +/* libm includes copysignl */ +#define HAVE_COPYSIGNL 1 + +/* libm includes cos */ +#define HAVE_COS 1 + +/* libm includes cosf */ +#define HAVE_COSF 1 + +/* libm includes cosh */ +#define HAVE_COSH 1 + +/* libm includes coshf */ +#define HAVE_COSHF 1 + +/* libm includes coshl */ +#define HAVE_COSHL 1 + +/* libm includes cosl */ +#define HAVE_COSL 1 + +/* libm includes cpow */ +#define HAVE_CPOW 1 + +/* libm includes cpowf */ +#define HAVE_CPOWF 1 + +/* libm includes cpowl */ +#define HAVE_CPOWL 1 + +/* Define if CRLF is line terminator. */ +/* #undef HAVE_CRLF */ + +/* libm includes csin */ +#define HAVE_CSIN 1 + +/* libm includes csinf */ +#define HAVE_CSINF 1 + +/* libm includes csinh */ +#define HAVE_CSINH 1 + +/* libm includes csinhf */ +#define HAVE_CSINHF 1 + +/* libm includes csinhl */ +#define HAVE_CSINHL 1 + +/* libm includes csinl */ +#define HAVE_CSINL 1 + +/* libm includes csqrt */ +#define HAVE_CSQRT 1 + +/* libm includes csqrtf */ +#define HAVE_CSQRTF 1 + +/* libm includes csqrtl */ +#define HAVE_CSQRTL 1 + +/* libm includes ctan */ +#define HAVE_CTAN 1 + +/* libm includes ctanf */ +#define HAVE_CTANF 1 + +/* libm includes ctanh */ +#define HAVE_CTANH 1 + +/* libm includes ctanhf */ +#define HAVE_CTANHF 1 + +/* libm includes ctanhl */ +#define HAVE_CTANHL 1 + +/* libm includes ctanl */ +#define HAVE_CTANL 1 + +/* Define to 1 if you have the `ctime' function. */ +#define HAVE_CTIME 1 + +/* libm includes erf */ +#define HAVE_ERF 1 + +/* libm includes erfc */ +#define HAVE_ERFC 1 + +/* libm includes erfcf */ +#define HAVE_ERFCF 1 + +/* libm includes erfcl */ +#define HAVE_ERFCL 1 + +/* libm includes erff */ +#define HAVE_ERFF 1 + +/* libm includes erfl */ +#define HAVE_ERFL 1 + +/* libm includes exp */ +#define HAVE_EXP 1 + +/* libm includes expf */ +#define HAVE_EXPF 1 + +/* libm includes expl */ +#define HAVE_EXPL 1 + +/* libm includes fabs */ +#define HAVE_FABS 1 + +/* libm includes fabsf */ +#define HAVE_FABSF 1 + +/* libm includes fabsl */ +#define HAVE_FABSL 1 + +/* libm includes feenableexcept */ +/* #undef HAVE_FEENABLEEXCEPT */ + +/* Define to 1 if you have the header file. */ +#define HAVE_FENV_H 1 + +/* libm includes finite */ +#define HAVE_FINITE 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_FLOATINGPOINT_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_FLOAT_H 1 + +/* libm includes floor */ +#define HAVE_FLOOR 1 + +/* libm includes floorf */ +#define HAVE_FLOORF 1 + +/* libm includes floorl */ +#define HAVE_FLOORL 1 + +/* Define if you have fpsetmask. */ +/* #undef HAVE_FPSETMASK */ + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_FPTRAP_H */ + +/* fp_enable is present */ +/* #undef HAVE_FP_ENABLE */ + +/* fp_trap is present */ +/* #undef HAVE_FP_TRAP */ + +/* libm includes frexp */ +#define HAVE_FREXP 1 + +/* libm includes frexpf */ +#define HAVE_FREXPF 1 + +/* libm includes frexpl */ +#define HAVE_FREXPL 1 + +/* Define to 1 if you have the `ftruncate' function. */ +#define HAVE_FTRUNCATE 1 + +/* libc includes getgid */ +#define HAVE_GETGID 1 + +/* Define to 1 if you have the `gethostname' function. */ +#define HAVE_GETHOSTNAME 1 + +/* Define to 1 if you have the `getlogin' function. */ +#define HAVE_GETLOGIN 1 + +/* Define to 1 if you have the `getpagesize' function. */ +#define HAVE_GETPAGESIZE 1 + +/* libc includes getpid */ +#define HAVE_GETPID 1 + +/* Define to 1 if you have the `getrusage' function. */ +#define HAVE_GETRUSAGE 1 + +/* Define to 1 if you have the `gettimeofday' function. */ +#define HAVE_GETTIMEOFDAY 1 + +/* libc includes getuid */ +#define HAVE_GETUID 1 + +/* Define if the compiler has a thread header that is non single. */ +/* #undef HAVE_GTHR_DEFAULT */ + +/* libm includes hypot */ +#define HAVE_HYPOT 1 + +/* libm includes hypotf */ +#define HAVE_HYPOTF 1 + +/* libm includes hypotl */ +#define HAVE_HYPOTL 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_IEEEFP_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_INTTYPES_H 1 + +/* libm includes j0 */ +#define HAVE_J0 1 + +/* libm includes j0f */ +/* #undef HAVE_J0F */ + +/* libm includes j0l */ +/* #undef HAVE_J0L */ + +/* libm includes j1 */ +#define HAVE_J1 1 + +/* libm includes j1f */ +/* #undef HAVE_J1F */ + +/* libm includes j1l */ +/* #undef HAVE_J1L */ + +/* libm includes jn */ +#define HAVE_JN 1 + +/* libm includes jnf */ +/* #undef HAVE_JNF */ + +/* libm includes jnl */ +/* #undef HAVE_JNL */ + +/* Define to 1 if you have the `kill' function. */ +#define HAVE_KILL 1 + +/* Define to 1 if you have the `link' function. */ +#define HAVE_LINK 1 + +/* libm includes log */ +#define HAVE_LOG 1 + +/* libm includes log10 */ +#define HAVE_LOG10 1 + +/* libm includes log10f */ +#define HAVE_LOG10F 1 + +/* libm includes log10l */ +#define HAVE_LOG10L 1 + +/* libm includes logf */ +#define HAVE_LOGF 1 + +/* libm includes logl */ +#define HAVE_LOGL 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_MATH_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_MEMORY_H 1 + +/* Define to 1 if you have the `mkstemp' function. */ +#define HAVE_MKSTEMP 1 + +/* Define to 1 if you have a working `mmap' system call. */ +#define HAVE_MMAP 1 + +/* libm includes nextafter */ +#define HAVE_NEXTAFTER 1 + +/* libm includes nextafterf */ +#define HAVE_NEXTAFTERF 1 + +/* libm includes nextafterl */ +#define HAVE_NEXTAFTERL 1 + +/* Define to 1 if you have the `perror' function. */ +#define HAVE_PERROR 1 + +/* libm includes pow */ +#define HAVE_POW 1 + +/* libm includes powf */ +#define HAVE_POWF 1 + +/* libm includes powl */ +#define HAVE_POWL 1 + +/* Define to 1 if the target supports #pragma weak */ +#define HAVE_PRAGMA_WEAK 1 + +/* libm includes round */ +#define HAVE_ROUND 1 + +/* libm includes roundf */ +#define HAVE_ROUNDF 1 + +/* libm includes roundl */ +#define HAVE_ROUNDL 1 + +/* libm includes scalbn */ +#define HAVE_SCALBN 1 + +/* libm includes scalbnf */ +#define HAVE_SCALBNF 1 + +/* libm includes scalbnl */ +#define HAVE_SCALBNL 1 + +/* Define to 1 if you have the `signal' function. */ +#define HAVE_SIGNAL 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SIGNAL_H 1 + +/* libm includes sin */ +#define HAVE_SIN 1 + +/* libm includes sinf */ +#define HAVE_SINF 1 + +/* libm includes sinh */ +#define HAVE_SINH 1 + +/* libm includes sinhf */ +#define HAVE_SINHF 1 + +/* libm includes sinhl */ +#define HAVE_SINHL 1 + +/* libm includes sinl */ +#define HAVE_SINL 1 + +/* Define to 1 if you have the `sleep' function. */ +#define HAVE_SLEEP 1 + +/* Define to 1 if you have the `snprintf' function. */ +#define HAVE_SNPRINTF 1 + +/* libm includes sqrt */ +#define HAVE_SQRT 1 + +/* libm includes sqrtf */ +#define HAVE_SQRTF 1 + +/* libm includes sqrtl */ +#define HAVE_SQRTL 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDDEF_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDINT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDIO_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDLIB_H 1 + +/* Define to 1 if you have the `strerror' function. */ +#define HAVE_STRERROR 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRINGS_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRING_H 1 + +/* Define to 1 if you have the `strtof' function. */ +#define HAVE_STRTOF 1 + +/* Define to 1 if you have the `strtold' function. */ +#define HAVE_STRTOLD 1 + +/* Define to 1 if `st_blksize' is member of `struct stat'. */ +#define HAVE_STRUCT_STAT_ST_BLKSIZE 1 + +/* Define to 1 if `st_blocks' is member of `struct stat'. */ +#define HAVE_STRUCT_STAT_ST_BLOCKS 1 + +/* Define to 1 if `st_rdev' is member of `struct stat'. */ +#define HAVE_STRUCT_STAT_ST_RDEV 1 + +/* Define to 1 if you have the `symlink' function. */ +#define HAVE_SYMLINK 1 + +/* Define to 1 if the target supports __sync_fetch_and_add */ +#define HAVE_SYNC_FETCH_AND_ADD 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_MMAN_H 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_SYS_PARAMS_H */ + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_RESOURCE_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_STAT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TIMES_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TIME_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TYPES_H 1 + +/* libm includes tan */ +#define HAVE_TAN 1 + +/* libm includes tanf */ +#define HAVE_TANF 1 + +/* libm includes tanh */ +#define HAVE_TANH 1 + +/* libm includes tanhf */ +#define HAVE_TANHF 1 + +/* libm includes tanhl */ +#define HAVE_TANHL 1 + +/* libm includes tanl */ +#define HAVE_TANL 1 + +/* Define to 1 if you have the `time' function. */ +#define HAVE_TIME 1 + +/* Define to 1 if you have the `times' function. */ +#define HAVE_TIMES 1 + +/* Do we have struct timezone */ +#define HAVE_TIMEZONE 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_TIME_H 1 + +/* libm includes trunc */ +#define HAVE_TRUNC 1 + +/* libm includes truncf */ +#define HAVE_TRUNCF 1 + +/* libm includes truncl */ +#define HAVE_TRUNCL 1 + +/* Define to 1 if you have the `ttyname' function. */ +#define HAVE_TTYNAME 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_UNISTD_H 1 + +/* Define if target can unlink open files. */ +#define HAVE_UNLINK_OPEN_FILE 1 + +/* Define if target has a reliable stat. */ +#define HAVE_WORKING_STAT 1 + +/* libm includes y0 */ +#define HAVE_Y0 1 + +/* libm includes y0f */ +/* #undef HAVE_Y0F */ + +/* libm includes y0l */ +/* #undef HAVE_Y0L */ + +/* libm includes y1 */ +#define HAVE_Y1 1 + +/* libm includes y1f */ +/* #undef HAVE_Y1F */ + +/* libm includes y1l */ +/* #undef HAVE_Y1L */ + +/* libm includes yn */ +#define HAVE_YN 1 + +/* libm includes ynf */ +/* #undef HAVE_YNF */ + +/* libm includes ynl */ +/* #undef HAVE_YNL */ + +/* Define to the address where bug reports for this package should be sent. */ +#define PACKAGE_BUGREPORT "" + +/* Define to the full name of this package. */ +#define PACKAGE_NAME "GNU Fortran Runtime Library" + +/* Define to the full name and version of this package. */ +#define PACKAGE_STRING "GNU Fortran Runtime Library 0.2" + +/* Define to the one symbol short name of this package. */ +#define PACKAGE_TARNAME "libgfortran" + +/* Define to the version of this package. */ +#define PACKAGE_VERSION "0.2" + +/* Define to 1 if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define to 1 if the target is ILP32. */ +#define TARGET_ILP32 1 + +/* Define to 1 if you can safely include both and . */ +#define TIME_WITH_SYS_TIME 1 + +/* Number of bits in a file offset, on hosts where this is settable. */ +/* #undef _FILE_OFFSET_BITS */ + +/* Define for large files, on AIX-style hosts. */ +/* #undef _LARGE_FILES */ + +/* Define to `long' if does not define. */ +/* #undef off_t */ diff -uNr dis45.ORIG/2.04/darwinadd.c dis45/2.04/darwinadd.c --- dis45.ORIG/2.04/darwinadd.c 2005-11-25 18:30:00.000000000 +0900 +++ dis45/2.04/darwinadd.c 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,28 @@ +#include +#include "io.h" +#include "unix.h" + +void flush_(int *lun) +{ + int fd = myfnum_(lun); + FILE *file = fdopen(fd, "a+"); + fflush(file); +} + +void fseek_(int *lun, int *offset, int *whence) +{ + gfc_unit *u = find_unit (*lun); + if (u == NULL) return; + + unix_stream *s = (unix_stream *)u->s; + if (!is_seekable(u->s)) return; + + if (s->physical_offset == (off_t)*offset) { + s->logical_offset = (off_t)*offset; + return; + } + + s->physical_offset = s->logical_offset = *offset; + int ret = lseek(s->fd, (off_t)*offset, *whence); + u->endfile = NO_ENDFILE; +} diff -uNr dis45.ORIG/2.04/fpu-target.h dis45/2.04/fpu-target.h --- dis45.ORIG/2.04/fpu-target.h 2005-11-28 15:38:29.000000000 +0900 +++ dis45/2.04/fpu-target.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,57 @@ +/* Fallback FPU-related code (for systems not otherwise supported). + Copyright 2005 Free Software Foundation, Inc. + Contributed by Francois-Xavier Coudert + +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 General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +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 General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + + +/* Fallback FPU-related code for systems not otherwise supported. This + is mainly telling the user that we will not be able to do what he + requested. */ + +void +set_fpu (void) +{ + if (options.fpe & GFC_FPE_INVALID) + st_printf ("Fortran runtime warning: IEEE 'invalid operation' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_DENORMAL) + st_printf ("Fortran runtime warning: IEEE 'denormal number' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_ZERO) + st_printf ("Fortran runtime warning: IEEE 'division by zero' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_OVERFLOW) + st_printf ("Fortran runtime warning: IEEE 'overflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_UNDERFLOW) + st_printf ("Fortran runtime warning: IEEE 'underflow' " + "exception not supported.\n"); + if (options.fpe & GFC_FPE_PRECISION) + st_printf ("Fortran runtime warning: IEEE 'loss of precision' " + "exception not supported.\n"); +} diff -uNr dis45.ORIG/2.04/io.h dis45/2.04/io.h --- dis45.ORIG/2.04/io.h 2005-11-28 15:38:35.000000000 +0900 +++ dis45/2.04/io.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,864 @@ +/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + Contributed by Andy Vaught + +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 General Public License as published by +the Free Software Foundation; either version 2, 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 General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Libgfortran; see the file COPYING. If not, write to +the Free Software Foundation, 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* As a special exception, if you link this library with other files, + some of which are compiled with GCC, to produce an executable, + this library does not by itself cause the resulting executable + to be covered by the GNU General Public License. + This exception does not however invalidate any other reasons why + the executable file might be covered by the GNU General Public License. */ + +#ifndef GFOR_IO_H +#define GFOR_IO_H + +/* IO library include. */ + +#include +#include "libgfortran.h" +#ifdef HAVE_PRAGMA_WEAK +/* Used by gthr.h. */ +#define SUPPORTS_WEAK 1 +#endif +#include + +#define DEFAULT_TEMPDIR "/tmp" + +/* Basic types used in data transfers. */ + +typedef enum +{ BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL, + BT_COMPLEX +} +bt; + + +typedef enum +{ SUCCESS = 1, FAILURE } +try; + +struct st_parameter_dt; + +typedef struct stream +{ + char *(*alloc_w_at) (struct stream *, int *, gfc_offset); + char *(*alloc_r_at) (struct stream *, int *, gfc_offset); + try (*sfree) (struct stream *); + try (*close) (struct stream *); + try (*seek) (struct stream *, gfc_offset); + try (*truncate) (struct stream *); + int (*read) (struct stream *, void *, size_t *); + int (*write) (struct stream *, const void *, size_t *); +} +stream; + + +/* Macros for doing file I/O given a stream. */ + +#define sfree(s) ((s)->sfree)(s) +#define sclose(s) ((s)->close)(s) + +#define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1) +#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1) + +#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where) +#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where) + +#define sseek(s, pos) ((s)->seek)(s, pos) +#define struncate(s) ((s)->truncate)(s) +#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes) +#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes) + +/* The array_loop_spec contains the variables for the loops over index ranges + that are encountered. Since the variables can be negative, ssize_t + is used. */ + +typedef struct array_loop_spec +{ + /* Index counter for this dimension. */ + ssize_t idx; + + /* Start for the index counter. */ + ssize_t start; + + /* End for the index counter. */ + ssize_t end; + + /* Step for the index counter. */ + ssize_t step; +} +array_loop_spec; + +/* Representation of a namelist object in libgfortran + + Namelist Records + &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../ + or + &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END + + The object can be a fully qualified, compound name for an instrinsic + type, derived types or derived type components. So, a substring + a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist + read. Hence full information about the structure of the object has + to be available to list_read.c and write. + + These requirements are met by the following data structures. + + namelist_info type contains all the scalar information about the + object and arrays of descriptor_dimension and array_loop_spec types for + arrays. */ + +typedef struct namelist_type +{ + + /* Object type, stored as GFC_DTYPE_xxxx. */ + bt type; + + /* Object name. */ + char * var_name; + + /* Address for the start of the object's data. */ + void * mem_pos; + + /* Flag to show that a read is to be attempted for this node. */ + int touched; + + /* Length of intrinsic type in bytes. */ + int len; + + /* Rank of the object. */ + int var_rank; + + /* Overall size of the object in bytes. */ + index_type size; + + /* Length of character string. */ + index_type string_length; + + descriptor_dimension * dim; + array_loop_spec * ls; + struct namelist_type * next; +} +namelist_info; + +/* Options for the OPEN statement. */ + +typedef enum +{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, + ACCESS_UNSPECIFIED +} +unit_access; + +typedef enum +{ ACTION_READ, ACTION_WRITE, ACTION_READWRITE, + ACTION_UNSPECIFIED +} +unit_action; + +typedef enum +{ BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED } +unit_blank; + +typedef enum +{ DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE, + DELIM_UNSPECIFIED +} +unit_delim; + +typedef enum +{ FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED } +unit_form; + +typedef enum +{ POSITION_ASIS, POSITION_REWIND, POSITION_APPEND, + POSITION_UNSPECIFIED +} +unit_position; + +typedef enum +{ STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH, + STATUS_REPLACE, STATUS_UNSPECIFIED +} +unit_status; + +typedef enum +{ PAD_YES, PAD_NO, PAD_UNSPECIFIED } +unit_pad; + +typedef enum +{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } +unit_advance; + +typedef enum +{READING, WRITING} +unit_mode; + +#define CHARACTER1(name) \ + char * name; \ + gfc_charlen_type name ## _len +#define CHARACTER2(name) \ + gfc_charlen_type name ## _len; \ + char * name + +#define IOPARM_LIBRETURN_MASK (3 << 0) +#define IOPARM_LIBRETURN_OK (0 << 0) +#define IOPARM_LIBRETURN_ERROR (1 << 0) +#define IOPARM_LIBRETURN_END (2 << 0) +#define IOPARM_LIBRETURN_EOR (3 << 0) +#define IOPARM_ERR (1 << 2) +#define IOPARM_END (1 << 3) +#define IOPARM_EOR (1 << 4) +#define IOPARM_HAS_IOSTAT (1 << 5) +#define IOPARM_HAS_IOMSG (1 << 6) + +#define IOPARM_COMMON_MASK ((1 << 7) - 1) + +typedef struct st_parameter_common +{ + GFC_INTEGER_4 flags; + GFC_INTEGER_4 unit; + const char *filename; + GFC_INTEGER_4 line; + CHARACTER2 (iomsg); + GFC_INTEGER_4 *iostat; +} +st_parameter_common; + +#define IOPARM_OPEN_HAS_RECL_IN (1 << 7) +#define IOPARM_OPEN_HAS_FILE (1 << 8) +#define IOPARM_OPEN_HAS_STATUS (1 << 9) +#define IOPARM_OPEN_HAS_ACCESS (1 << 10) +#define IOPARM_OPEN_HAS_FORM (1 << 11) +#define IOPARM_OPEN_HAS_BLANK (1 << 12) +#define IOPARM_OPEN_HAS_POSITION (1 << 13) +#define IOPARM_OPEN_HAS_ACTION (1 << 14) +#define IOPARM_OPEN_HAS_DELIM (1 << 15) +#define IOPARM_OPEN_HAS_PAD (1 << 16) + +typedef struct +{ + st_parameter_common common; + GFC_INTEGER_4 recl_in; + CHARACTER2 (file); + CHARACTER1 (status); + CHARACTER2 (access); + CHARACTER1 (form); + CHARACTER2 (blank); + CHARACTER1 (position); + CHARACTER2 (action); + CHARACTER1 (delim); + CHARACTER2 (pad); +} +st_parameter_open; + +#define IOPARM_CLOSE_HAS_STATUS (1 << 7) + +typedef struct +{ + st_parameter_common common; + CHARACTER1 (status); +} +st_parameter_close; + +typedef struct +{ + st_parameter_common common; +} +st_parameter_filepos; + +#define IOPARM_INQUIRE_HAS_EXIST (1 << 7) +#define IOPARM_INQUIRE_HAS_OPENED (1 << 8) +#define IOPARM_INQUIRE_HAS_NUMBER (1 << 9) +#define IOPARM_INQUIRE_HAS_NAMED (1 << 10) +#define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) +#define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) +#define IOPARM_INQUIRE_HAS_FILE (1 << 13) +#define IOPARM_INQUIRE_HAS_ACCESS (1 << 14) +#define IOPARM_INQUIRE_HAS_FORM (1 << 15) +#define IOPARM_INQUIRE_HAS_BLANK (1 << 16) +#define IOPARM_INQUIRE_HAS_POSITION (1 << 17) +#define IOPARM_INQUIRE_HAS_ACTION (1 << 18) +#define IOPARM_INQUIRE_HAS_DELIM (1 << 19) +#define IOPARM_INQUIRE_HAS_PAD (1 << 20) +#define IOPARM_INQUIRE_HAS_NAME (1 << 21) +#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 22) +#define IOPARM_INQUIRE_HAS_DIRECT (1 << 23) +#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 24) +#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25) +#define IOPARM_INQUIRE_HAS_READ (1 << 26) +#define IOPARM_INQUIRE_HAS_WRITE (1 << 27) +#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28) + +typedef struct +{ + st_parameter_common common; + GFC_INTEGER_4 *exist, *opened, *number, *named; + GFC_INTEGER_4 *nextrec, *recl_out; + CHARACTER1 (file); + CHARACTER2 (access); + CHARACTER1 (form); + CHARACTER2 (blank); + CHARACTER1 (position); + CHARACTER2 (action); + CHARACTER1 (delim); + CHARACTER2 (pad); + CHARACTER1 (name); + CHARACTER2 (sequential); + CHARACTER1 (direct); + CHARACTER2 (formatted); + CHARACTER1 (unformatted); + CHARACTER2 (read); + CHARACTER1 (write); + CHARACTER2 (readwrite); +} +st_parameter_inquire; + +struct gfc_unit; +struct format_data; + +#define IOPARM_DT_LIST_FORMAT (1 << 7) +#define IOPARM_DT_NAMELIST_READ_MODE (1 << 8) +#define IOPARM_DT_HAS_REC (1 << 9) +#define IOPARM_DT_HAS_SIZE (1 << 10) +#define IOPARM_DT_HAS_IOLENGTH (1 << 11) +#define IOPARM_DT_HAS_FORMAT (1 << 12) +#define IOPARM_DT_HAS_ADVANCE (1 << 13) +#define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) +#define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) +/* Internal use bit. */ +#define IOPARM_DT_IONML_SET (1 << 31) + +typedef struct st_parameter_dt +{ + st_parameter_common common; + GFC_INTEGER_4 rec; + GFC_INTEGER_4 *size, *iolength; + gfc_array_char *internal_unit_desc; + CHARACTER1 (format); + CHARACTER2 (advance); + CHARACTER1 (internal_unit); + CHARACTER2 (namelist_name); + /* Private part of the structure. The compiler just needs + to reserve enough space. */ + union + { + struct + { + void (*transfer) (struct st_parameter_dt *, bt, void *, int, + size_t, size_t); + struct gfc_unit *current_unit; + int item_count; /* Item number in a formatted data transfer. */ + unit_mode mode; + unit_blank blank_status; + enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status; + int scale_factor; + int max_pos; /* Maximum righthand column written to. */ + /* Number of skips + spaces to be done for T and X-editing. */ + int skips; + /* Number of spaces to be done for T and X-editing. */ + int pending_spaces; + unit_advance advance_status; + char reversion_flag; /* Format reversion has occurred. */ + char first_item; + char seen_dollar; + char sf_seen_eor; + char eor_condition; + char no_leading_blank; + char nml_delim; + char char_flag; + char input_complete; + char at_eol; + char comma_flag; + char last_char; + /* A namelist specific flag used in the list directed library + to flag that calls are being made from namelist read (eg. to + ignore comments or to treat '/' as a terminator) */ + char namelist_mode; + /* A namelist specific flag used in the list directed library + to flag read errors and return, so that an attempt can be + made to read a new object name. */ + char nml_read_error; + /* Storage area for values except for strings. Must be large + enough to hold a complex value (two reals) of the largest + kind. */ + char value[32]; + int repeat_count; + int saved_length; + int saved_used; + bt saved_type; + char *saved_string; + char *scratch; + char *line_buffer; + struct format_data *fmt; + jmp_buf *eof_jump; + namelist_info *ionml; + } p; + char pad[16 * sizeof (char *) + 32 * sizeof (int)]; + } u; +} +st_parameter_dt; + +#undef CHARACTER1 +#undef CHARACTER2 + +typedef struct +{ + unit_access access; + unit_action action; + unit_blank blank; + unit_delim delim; + unit_form form; + int is_notpadded; + unit_position position; + unit_status status; + unit_pad pad; +} +unit_flags; + + +/* The default value of record length for preconnected units is defined + here. This value can be overriden by an environment variable. + Default value is 1 Gb. */ + +#define DEFAULT_RECL 1073741824 + + +typedef struct gfc_unit +{ + int unit_number; + stream *s; + + /* Treap links. */ + struct gfc_unit *left, *right; + int priority; + + int read_bad, current_record; + enum + { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } + endfile; + + unit_mode mode; + unit_flags flags; + + /* recl -- Record length of the file. + last_record -- Last record number read or written + maxrec -- Maximum record number in a direct access file + bytes_left -- Bytes left in current record. */ + gfc_offset recl, last_record, maxrec, bytes_left; + + __gthread_mutex_t lock; + /* Number of threads waiting to acquire this unit's lock. + When non-zero, close_unit doesn't only removes the unit + from the UNIT_ROOT tree, but doesn't free it and the + last of the waiting threads will do that. + This must be either atomically increased/decreased, or + always guarded by UNIT_LOCK. */ + int waiting; + /* Flag set by close_unit if the unit as been closed. + Must be manipulated under unit's lock. */ + int closed; + + /* For traversing arrays */ + array_loop_spec *ls; + int rank; + + int file_len; + char *file; +} +gfc_unit; + +/* Format tokens. Only about half of these can be stored in the + format nodes. */ + +typedef enum +{ + FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD, + FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL, + FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING, + FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F, + FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END +} +format_token; + + +/* Format nodes. A format string is converted into a tree of these + structures, which is traversed as part of a data transfer statement. */ + +typedef struct fnode +{ + format_token format; + int repeat; + struct fnode *next; + char *source; + + union + { + struct + { + int w, d, e; + } + real; + + struct + { + int length; + char *p; + } + string; + + struct + { + int w, m; + } + integer; + + int w; + int k; + int r; + int n; + + struct fnode *child; + } + u; + + /* Members for traversing the tree during data transfer. */ + + int count; + struct fnode *current; + +} +fnode; + + +/* unix.c */ + +extern int move_pos_offset (stream *, int); +internal_proto(move_pos_offset); + +extern int compare_files (stream *, stream *); +internal_proto(compare_files); + +extern stream *open_external (st_parameter_open *, unit_flags *); +internal_proto(open_external); + +extern stream *open_internal (char *, int); +internal_proto(open_internal); + +extern stream *input_stream (void); +internal_proto(input_stream); + +extern stream *output_stream (void); +internal_proto(output_stream); + +extern stream *error_stream (void); +internal_proto(error_stream); + +extern int compare_file_filename (gfc_unit *, const char *, int); +internal_proto(compare_file_filename); + +extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); +internal_proto(find_file); + +extern void flush_all_units (void); +internal_proto(flush_all_units); + +extern int stream_at_bof (stream *); +internal_proto(stream_at_bof); + +extern int stream_at_eof (stream *); +internal_proto(stream_at_eof); + +extern int delete_file (gfc_unit *); +internal_proto(delete_file); + +extern int file_exists (const char *file, gfc_charlen_type file_len); +internal_proto(file_exists); + +extern const char *inquire_sequential (const char *, int); +internal_proto(inquire_sequential); + +extern const char *inquire_direct (const char *, int); +internal_proto(inquire_direct); + +extern const char *inquire_formatted (const char *, int); +internal_proto(inquire_formatted); + +extern const char *inquire_unformatted (const char *, int); +internal_proto(inquire_unformatted); + +extern const char *inquire_read (const char *, int); +internal_proto(inquire_read); + +extern const char *inquire_write (const char *, int); +internal_proto(inquire_write); + +extern const char *inquire_readwrite (const char *, int); +internal_proto(inquire_readwrite); + +extern gfc_offset file_length (stream *); +internal_proto(file_length); + +extern gfc_offset file_position (stream *); +internal_proto(file_position); + +extern int is_seekable (stream *); +internal_proto(is_seekable); + +extern int is_preconnected (stream *); +internal_proto(is_preconnected); + +extern void flush_if_preconnected (stream *); +internal_proto(flush_if_preconnected); + +extern void empty_internal_buffer(stream *); +internal_proto(empty_internal_buffer); + +extern try flush (stream *); +internal_proto(flush); + +extern int stream_isatty (stream *); +internal_proto(stream_isatty); + +extern char * stream_ttyname (stream *); +internal_proto(stream_ttyname); + +extern gfc_offset stream_offset (stream *s); +internal_proto(stream_offset); + +extern int unit_to_fd (int); +internal_proto(unit_to_fd); + +extern int unpack_filename (char *, const char *, int); +internal_proto(unpack_filename); + +/* unit.c */ + +/* Maximum file offset, computed at library initialization time. */ +extern gfc_offset max_offset; +internal_proto(max_offset); + +/* Unit tree root. */ +extern gfc_unit *unit_root; +internal_proto(unit_root); + +extern __gthread_mutex_t unit_lock; +internal_proto(unit_lock); + +extern int close_unit (gfc_unit *); +internal_proto(close_unit); + +extern int is_internal_unit (st_parameter_dt *); +internal_proto(is_internal_unit); + +extern int is_array_io (st_parameter_dt *); +internal_proto(is_array_io); + +extern gfc_unit *find_unit (int); +internal_proto(find_unit); + +extern gfc_unit *find_or_create_unit (int); +internal_proto(find_unit); + +extern gfc_unit *get_unit (st_parameter_dt *, int); +internal_proto(get_unit); + +extern void unlock_unit (gfc_unit *); +internal_proto(unlock_unit); + +/* open.c */ + +extern void test_endfile (gfc_unit *); +internal_proto(test_endfile); + +extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); +internal_proto(new_unit); + +/* format.c */ + +extern void parse_format (st_parameter_dt *); +internal_proto(parse_format); + +extern const fnode *next_format (st_parameter_dt *); +internal_proto(next_format); + +extern void unget_format (st_parameter_dt *, const fnode *); +internal_proto(unget_format); + +extern void format_error (st_parameter_dt *, const fnode *, const char *); +internal_proto(format_error); + +extern void free_format_data (st_parameter_dt *); +internal_proto(free_format_data); + +/* transfer.c */ + +#define SCRATCH_SIZE 300 + +extern const char *type_name (bt); +internal_proto(type_name); + +extern void *read_block (st_parameter_dt *, int *); +internal_proto(read_block); + +extern void *write_block (st_parameter_dt *, int); +internal_proto(write_block); + +extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *); +internal_proto(next_array_record); + +extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *); +internal_proto(init_loop_spec); + +extern void next_record (st_parameter_dt *, int); +internal_proto(next_record); + +/* read.c */ + +extern void set_integer (void *, GFC_INTEGER_LARGEST, int); +internal_proto(set_integer); + +extern GFC_UINTEGER_LARGEST max_value (int, int); +internal_proto(max_value); + +extern int convert_real (st_parameter_dt *, void *, const char *, int); +internal_proto(convert_real); + +extern void read_a (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_a); + +extern void read_f (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_f); + +extern void read_l (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_l); + +extern void read_x (st_parameter_dt *, int); +internal_proto(read_x); + +extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int); +internal_proto(read_radix); + +extern void read_decimal (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_decimal); + +/* list_read.c */ + +extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t, + size_t); +internal_proto(list_formatted_read); + +extern void finish_list_read (st_parameter_dt *); +internal_proto(finish_list_read); + +extern void namelist_read (st_parameter_dt *); +internal_proto(namelist_read); + +extern void namelist_write (st_parameter_dt *); +internal_proto(namelist_write); + +/* write.c */ + +extern void write_a (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_a); + +extern void write_b (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_b); + +extern void write_d (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_d); + +extern void write_e (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_e); + +extern void write_en (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_en); + +extern void write_es (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_es); + +extern void write_f (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_f); + +extern void write_i (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_i); + +extern void write_l (st_parameter_dt *, const fnode *, char *, int); +internal_proto(write_l); + +extern void write_o (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_o); + +extern void write_x (st_parameter_dt *, int, int); +internal_proto(write_x); + +extern void write_z (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_z); + +extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, + size_t); +internal_proto(list_formatted_write); + +/* error.c */ +extern try notify_std (int, const char *); +internal_proto(notify_std); + +/* size_from_kind.c */ +extern size_t size_from_real_kind (int); +internal_proto(size_from_real_kind); + +extern size_t size_from_complex_kind (int); +internal_proto(size_from_complex_kind); + +/* lock.c */ +extern void free_ionml (st_parameter_dt *); +internal_proto(free_ionml); + +static inline void +inc_waiting_locked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, 1); +#else + u->waiting++; +#endif +} + +static inline int +predec_waiting_locked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + return __sync_add_and_fetch (&u->waiting, -1); +#else + return --u->waiting; +#endif +} + +static inline void +dec_waiting_unlocked (gfc_unit *u) +{ +#ifdef HAVE_SYNC_FETCH_AND_ADD + (void) __sync_fetch_and_add (&u->waiting, -1); +#else + __gthread_mutex_lock (&unit_lock); + u->waiting--; + __gthread_mutex_unlock (&unit_lock); +#endif +} + +#endif diff -uNr dis45.ORIG/2.04/kinds.h dis45/2.04/kinds.h --- dis45.ORIG/2.04/kinds.h 2005-11-28 15:38:44.000000000 +0900 +++ dis45/2.04/kinds.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,37 @@ +typedef int8_t GFC_INTEGER_1; +typedef uint8_t GFC_UINTEGER_1; +typedef GFC_INTEGER_1 GFC_LOGICAL_1; +#define HAVE_GFC_LOGICAL_1 +#define HAVE_GFC_INTEGER_1 +typedef int16_t GFC_INTEGER_2; +typedef uint16_t GFC_UINTEGER_2; +typedef GFC_INTEGER_2 GFC_LOGICAL_2; +#define HAVE_GFC_LOGICAL_2 +#define HAVE_GFC_INTEGER_2 +typedef int32_t GFC_INTEGER_4; +typedef uint32_t GFC_UINTEGER_4; +typedef GFC_INTEGER_4 GFC_LOGICAL_4; +#define HAVE_GFC_LOGICAL_4 +#define HAVE_GFC_INTEGER_4 +typedef int64_t GFC_INTEGER_8; +typedef uint64_t GFC_UINTEGER_8; +typedef GFC_INTEGER_8 GFC_LOGICAL_8; +#define HAVE_GFC_LOGICAL_8 +#define HAVE_GFC_INTEGER_8 +#define GFC_INTEGER_LARGEST GFC_INTEGER_8 +#define GFC_UINTEGER_LARGEST GFC_UINTEGER_8 + +typedef float GFC_REAL_4; +typedef complex float GFC_COMPLEX_4; +#define HAVE_GFC_REAL_4 +#define HAVE_GFC_COMPLEX_4 +typedef double GFC_REAL_8; +typedef complex double GFC_COMPLEX_8; +#define HAVE_GFC_REAL_8 +#define HAVE_GFC_COMPLEX_8 +typedef long double GFC_REAL_16; +typedef complex long double GFC_COMPLEX_16; +#define HAVE_GFC_REAL_16 +#define HAVE_GFC_COMPLEX_16 +#define GFC_REAL_LARGEST_FORMAT "L" +#define GFC_REAL_LARGEST long double diff -uNr dis45.ORIG/2.04/libgfortran.h dis45/2.04/libgfortran.h --- dis45.ORIG/2.04/libgfortran.h 2005-11-28 15:38:51.000000000 +0900 +++ dis45/2.04/libgfortran.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,637 @@ +/* Common declarations for all of libgfor. + Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. + Contributed by Paul Brook , and + Andy Vaught + +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. + +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., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* As a special exception, if you link this library with other files, + some of which are compiled with GCC, to produce an executable, + this library does not by itself cause the resulting executable + to be covered by the GNU General Public License. + This exception does not however invalidate any other reasons why + the executable file might be covered by the GNU General Public License. */ + + +#ifndef LIBGFOR_H +#define LIBGFOR_H + +#include +#include + +#ifndef M_PI +#define M_PI 3.14159265358979323846264338327 +#endif + +#if HAVE_COMPLEX_H +# include +#else +#define complex __complex__ +#endif + +#include "config.h" +#include "c99_protos.h" + +#if HAVE_IEEEFP_H +#include +#endif + +#if HAVE_STDINT_H +#include +#endif + +#if HAVE_INTTYPES_H +#include +#endif + +#if !defined(HAVE_STDINT_H) && !defined(HAVE_INTTYPES_H) && defined(TARGET_ILP32) +typedef char int8_t; +typedef short int16_t; +typedef int int32_t; +typedef long long int64_t; +typedef unsigned char uint8_t; +typedef unsigned short uint16_t; +typedef unsigned int uint32_t; +typedef unsigned long long uint64_t; +#endif + +#if HAVE_SYS_TYPES_H +#include +#endif +typedef off_t gfc_offset; + +#ifndef NULL +#define NULL (void *) 0 +#endif + +#ifndef __GNUC__ +#define __attribute__(x) +#endif + +/* For a library, a standard prefix is a requirement in order to partition + the namespace. IPREFIX is for symbols intended to be internal to the + library. */ +#define PREFIX(x) _gfortran_ ## x +#define IPREFIX(x) _gfortrani_ ## x + +/* Magic to rename a symbol at the compiler level. You continue to refer + to the symbol as OLD in the source, but it'll be named NEW in the asm. */ +#define sym_rename(old, new) sym_rename1(old, __USER_LABEL_PREFIX__, new) +#define sym_rename1(old, ulp, new) sym_rename2(old, ulp, new) +#define sym_rename2(old, ulp, new) extern __typeof(old) old __asm__(#ulp #new) + +/* There are several classifications of routines: + + (1) Symbols used only within the library, + (2) Symbols to be exported from the library, + (3) Symbols to be exported from the library, but + also used inside the library. + + By telling the compiler about these different classifications we can + tightly control the interface seen by the user, and get better code + from the compiler at the same time. + + One of the following should be used immediately after the declaration + of each symbol: + + internal_proto Marks a symbol used only within the library, + and adds IPREFIX to the assembly-level symbol + name. The later is important for maintaining + the namespace partition for the static library. + + export_proto Marks a symbol to be exported, and adds PREFIX + to the assembly-level symbol name. + + export_proto_np Marks a symbol to be exported without adding PREFIX. + + iexport_proto Marks a function to be exported, but with the + understanding that it can be used inside as well. + + iexport_data_proto Similarly, marks a data symbol to be exported. + Unfortunately, some systems can't play the hidden + symbol renaming trick on data symbols, thanks to + the horribleness of COPY relocations. + + If iexport_proto or iexport_data_proto is used, you must also use + iexport or iexport_data after the *definition* of the symbol. */ + +#if defined(HAVE_ATTRIBUTE_VISIBILITY) +# define internal_proto(x) \ + sym_rename(x, IPREFIX (x)) __attribute__((__visibility__("hidden"))) +#else +# define internal_proto(x) sym_rename(x, IPREFIX(x)) +#endif + +#if defined(HAVE_ATTRIBUTE_VISIBILITY) && defined(HAVE_ATTRIBUTE_ALIAS) +# define export_proto(x) sym_rename(x, PREFIX(x)) +# define export_proto_np(x) extern char swallow_semicolon +# define iexport_proto(x) internal_proto(x) +# define iexport(x) iexport1(x, __USER_LABEL_PREFIX__, IPREFIX(x)) +# define iexport1(x,p,y) iexport2(x,p,y) +# define iexport2(x,p,y) \ + extern __typeof(x) PREFIX(x) __attribute__((__alias__(#p #y))) +/* ??? We're not currently building a dll, and it's wrong to add dllexport + to objects going into a static library archive. */ +#elif 0 && defined(HAVE_ATTRIBUTE_DLLEXPORT) +# define export_proto_np(x) extern __typeof(x) x __attribute__((dllexport)) +# define export_proto(x) sym_rename(x, PREFIX(x)) __attribute__((dllexport)) +# define iexport_proto(x) export_proto(x) +# define iexport(x) extern char swallow_semicolon +#else +# define export_proto(x) sym_rename(x, PREFIX(x)) +# define export_proto_np(x) extern char swallow_semicolon +# define iexport_proto(x) export_proto(x) +# define iexport(x) extern char swallow_semicolon +#endif + +/* TODO: detect the case when we *can* hide the symbol. */ +#define iexport_data_proto(x) export_proto(x) +#define iexport_data(x) extern char swallow_semicolon + +/* The only reliable way to get the offset of a field in a struct + in a system independent way is via this macro. */ +#ifndef offsetof +#define offsetof(TYPE, MEMBER) ((size_t) &((TYPE *) 0)->MEMBER) +#endif + +/* The isfinite macro is only available with C99, but some non-C99 + systems still provide fpclassify, and there is a `finite' function + in BSD. + + Also, isfinite is broken on Cygwin. + + When isfinite is not available, try to use one of the + alternatives, or bail out. */ + +#if defined(HAVE_BROKEN_ISFINITE) || defined(__CYGWIN__) +#undef isfinite +#endif + +#if defined(HAVE_BROKEN_ISNAN) +#undef isnan +#endif + +#if defined(HAVE_BROKEN_FPCLASSIFY) +#undef fpclassify +#endif + +#if !defined(isfinite) +#if !defined(fpclassify) +#define isfinite(x) ((x) - (x) == 0) +#else +#define isfinite(x) (fpclassify(x) != FP_NAN && fpclassify(x) != FP_INFINITE) +#endif /* !defined(fpclassify) */ +#endif /* !defined(isfinite) */ + +#if !defined(isnan) +#if !defined(fpclassify) +#define isnan(x) ((x) != (x)) +#else +#define isnan(x) (fpclassify(x) == FP_NAN) +#endif /* !defined(fpclassify) */ +#endif /* !defined(isfinite) */ + +/* TODO: find the C99 version of these an move into above ifdef. */ +#define REALPART(z) (__real__(z)) +#define IMAGPART(z) (__imag__(z)) +#define COMPLEX_ASSIGN(z_, r_, i_) {__real__(z_) = (r_); __imag__(z_) = (i_);} + +#include "kinds.h" + +/* The following two definitions must be consistent with the types used + by the compiler. */ +/* The type used of array indices, amongst other things. */ +typedef ssize_t index_type; +/* The type used for the lengths of character variables. */ +typedef GFC_INTEGER_4 gfc_charlen_type; + +/* This will be 0 on little-endian machines and one on big-endian machines. */ +extern int l8_to_l4_offset; +internal_proto(l8_to_l4_offset); + +#define GFOR_POINTER_L8_TO_L4(p8) \ + (l8_to_l4_offset + (GFC_LOGICAL_4 *)(p8)) + +#define GFC_INTEGER_4_HUGE \ + (GFC_INTEGER_4)((((GFC_UINTEGER_4)1) << 31) - 1) +#define GFC_INTEGER_8_HUGE \ + (GFC_INTEGER_8)((((GFC_UINTEGER_8)1) << 63) - 1) +#ifdef HAVE_GFC_INTEGER_16 +#define GFC_INTEGER_16_HUGE \ + (GFC_INTEGER_16)((((GFC_UINTEGER_16)1) << 127) - 1) +#endif + +#define GFC_REAL_4_HUGE FLT_MAX +#define GFC_REAL_8_HUGE DBL_MAX +#ifdef HAVE_GFC_REAL_10 +#define GFC_REAL_10_HUGE LDBL_MAX +#endif +#ifdef HAVE_GFC_REAL_16 +#define GFC_REAL_16_HUGE LDBL_MAX +#endif + +#ifndef GFC_MAX_DIMENSIONS +#define GFC_MAX_DIMENSIONS 7 +#endif + +typedef struct descriptor_dimension +{ + index_type stride; + index_type lbound; + index_type ubound; +} +descriptor_dimension; + +#define GFC_ARRAY_DESCRIPTOR(r, type) \ +struct {\ + type *data;\ + size_t offset;\ + index_type dtype;\ + descriptor_dimension dim[r];\ +} + +/* Commonly used array descriptor types. */ +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) gfc_array_void; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, char) gfc_array_char; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_4) gfc_array_i4; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_8) gfc_array_i8; +#ifdef HAVE_GFC_INTEGER_16 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_INTEGER_16) gfc_array_i16; +#endif +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_4) gfc_array_r4; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_8) gfc_array_r8; +#ifdef HAVE_GFC_REAL_10 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_10) gfc_array_r10; +#endif +#ifdef HAVE_GFC_REAL_16 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_REAL_16) gfc_array_r16; +#endif +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_4) gfc_array_c4; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_8) gfc_array_c8; +#ifdef HAVE_GFC_COMPLEX_10 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_10) gfc_array_c10; +#endif +#ifdef HAVE_GFC_COMPLEX_16 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_COMPLEX_16) gfc_array_c16; +#endif +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_4) gfc_array_l4; +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; +#ifdef HAVE_GFC_LOGICAL_16 +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; +#endif + +#define GFC_DTYPE_RANK_MASK 0x07 +#define GFC_DTYPE_TYPE_SHIFT 3 +#define GFC_DTYPE_TYPE_MASK 0x38 +#define GFC_DTYPE_SIZE_SHIFT 6 + +enum +{ + GFC_DTYPE_UNKNOWN = 0, + GFC_DTYPE_INTEGER, + /* TODO: recognize logical types. */ + GFC_DTYPE_LOGICAL, + GFC_DTYPE_REAL, + GFC_DTYPE_COMPLEX, + GFC_DTYPE_DERIVED, + GFC_DTYPE_CHARACTER +}; + +#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK) +#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \ + >> GFC_DTYPE_TYPE_SHIFT) +#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT) +#define GFC_DESCRIPTOR_DATA(desc) ((desc)->data) +#define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype) + +/* Runtime library include. */ +#define stringize(x) expand_macro(x) +#define expand_macro(x) # x + +/* Runtime options structure. */ + +typedef struct +{ + int stdin_unit, stdout_unit, stderr_unit, optional_plus; + int allocate_init_flag, allocate_init_value; + int locus; + + int separator_len; + const char *separator; + + int mem_check; + int use_stderr, all_unbuffered, default_recl; + + int fpu_round, fpu_precision, fpe; + + int sighup, sigint; +} +options_t; + +extern options_t options; +internal_proto(options); + + +/* Compile-time options that will influence the library. */ + +typedef struct +{ + int warn_std; + int allow_std; +} +compile_options_t; + +extern compile_options_t compile_options; +internal_proto(compile_options); + +extern void init_compile_options (void); +internal_proto(init_compile_options); + + +/* Structure for statement options. */ + +typedef struct +{ + const char *name; + int value; +} +st_option; + +/* Runtime errors. The EOR and EOF errors are required to be negative. */ + +typedef enum +{ + ERROR_FIRST = -3, /* Marker for the first error. */ + ERROR_EOR = -2, + ERROR_END = -1, + ERROR_OK = 0, /* Indicates success, must be zero. */ + ERROR_OS, /* Operating system error, more info in errno. */ + ERROR_OPTION_CONFLICT, + ERROR_BAD_OPTION, + ERROR_MISSING_OPTION, + ERROR_ALREADY_OPEN, + ERROR_BAD_UNIT, + ERROR_FORMAT, + ERROR_BAD_ACTION, + ERROR_ENDFILE, + ERROR_BAD_US, + ERROR_READ_VALUE, + ERROR_READ_OVERFLOW, + ERROR_LAST /* Not a real error, the last error # + 1. */ +} +error_codes; + + +/* Flags to specify which standard/extension contains a feature. + Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */ +#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ +#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ +#define GFC_STD_F2003 (1<<4) /* New in F2003. */ +/* Note that no features were obsoleted nor deleted in F2003. */ +#define GFC_STD_F95 (1<<3) /* New in F95. */ +#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */ +#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */ +#define GFC_STD_F77 (1<<0) /* Up to and including F77. */ + +/* Bitmasks for the various FPE that can be enabled. + Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */ +#define GFC_FPE_INVALID (1<<0) +#define GFC_FPE_DENORMAL (1<<1) +#define GFC_FPE_ZERO (1<<2) +#define GFC_FPE_OVERFLOW (1<<3) +#define GFC_FPE_UNDERFLOW (1<<4) +#define GFC_FPE_PRECISION (1<<5) + +/* The filename and line number don't go inside the globals structure. + They are set by the rest of the program and must be linked to. */ + +/* Location of the current library call (optional). */ +extern unsigned line; +iexport_data_proto(line); + +extern char *filename; +iexport_data_proto(filename); + +/* Avoid conflicting prototypes of alloca() in system headers by using + GCC's builtin alloca(). */ +#define gfc_alloca(x) __builtin_alloca(x) + + +/* main.c */ + +extern void stupid_function_name_for_static_linking (void); +internal_proto(stupid_function_name_for_static_linking); + +struct st_parameter_common; +extern void library_start (struct st_parameter_common *); +internal_proto(library_start); + +#define library_end() + +extern void set_args (int, char **); +export_proto(set_args); + +extern void get_args (int *, char ***); +internal_proto(get_args); + +/* error.c */ + +#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2) +#define GFC_XTOA_BUF_SIZE (sizeof (GFC_UINTEGER_LARGEST) * 2 + 1) +#define GFC_OTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 1) +#define GFC_BTOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 8 + 1) + +extern const char *gfc_itoa (GFC_INTEGER_LARGEST, char *, size_t); +internal_proto(gfc_itoa); + +extern const char *xtoa (GFC_UINTEGER_LARGEST, char *, size_t); +internal_proto(xtoa); + +extern void os_error (const char *) __attribute__ ((noreturn)); +internal_proto(os_error); + +extern void show_locus (struct st_parameter_common *); +internal_proto(show_locus); + +extern void runtime_error (const char *) __attribute__ ((noreturn)); +iexport_proto(runtime_error); + +extern void internal_error (struct st_parameter_common *, const char *) + __attribute__ ((noreturn)); +internal_proto(internal_error); + +extern const char *get_oserror (void); +internal_proto(get_oserror); + +extern void sys_exit (int) __attribute__ ((noreturn)); +internal_proto(sys_exit); + +extern int st_printf (const char *, ...) + __attribute__ ((format (printf, 1, 2))); +internal_proto(st_printf); + +extern void st_sprintf (char *, const char *, ...) + __attribute__ ((format (printf, 2, 3))); +internal_proto(st_sprintf); + +extern const char *translate_error (int); +internal_proto(translate_error); + +extern void generate_error (struct st_parameter_common *, int, const char *); +internal_proto(generate_error); + +/* fpu.c */ + +extern void set_fpu (void); +internal_proto(set_fpu); + +/* memory.c */ + +extern void *get_mem (size_t) __attribute__ ((malloc)); +internal_proto(get_mem); + +extern void free_mem (void *); +internal_proto(free_mem); + +extern void *internal_malloc_size (size_t); +internal_proto(internal_malloc_size); + +extern void internal_free (void *); +iexport_proto(internal_free); + +/* environ.c */ + +extern int check_buffered (int); +internal_proto(check_buffered); + +extern void init_variables (void); +internal_proto(init_variables); + +extern void show_variables (void); +internal_proto(show_variables); + +/* string.c */ + +extern int find_option (struct st_parameter_common *, const char *, int, + const st_option *, const char *); +internal_proto(find_option); + +extern int fstrlen (const char *, int); +internal_proto(fstrlen); + +extern void fstrcpy (char *, int, const char *, int); +internal_proto(fstrcpy); + +extern void cf_strcpy (char *, int, const char *); +internal_proto(cf_strcpy); + +/* io.c */ + +extern void init_units (void); +internal_proto(init_units); + +extern void close_units (void); +internal_proto(close_units); + +/* stop.c */ + +extern void stop_numeric (GFC_INTEGER_4); +iexport_proto(stop_numeric); + +/* reshape_packed.c */ + +extern void reshape_packed (char *, index_type, const char *, index_type, + const char *, index_type); +internal_proto(reshape_packed); + +/* Repacking functions. */ + +/* ??? These aren't currently used by the compiler, though we + certainly could do so. */ +GFC_INTEGER_4 *internal_pack_4 (gfc_array_i4 *); +internal_proto(internal_pack_4); + +GFC_INTEGER_8 *internal_pack_8 (gfc_array_i8 *); +internal_proto(internal_pack_8); + +#if defined HAVE_GFC_INTEGER_16 +GFC_INTEGER_16 *internal_pack_16 (gfc_array_i16 *); +internal_proto(internal_pack_16); +#endif + +GFC_COMPLEX_4 *internal_pack_c4 (gfc_array_c4 *); +internal_proto(internal_pack_c4); + +GFC_COMPLEX_8 *internal_pack_c8 (gfc_array_c8 *); +internal_proto(internal_pack_c8); + +#if defined HAVE_GFC_COMPLEX_10 +GFC_COMPLEX_10 *internal_pack_c10 (gfc_array_c10 *); +internal_proto(internal_pack_c10); +#endif + +extern void internal_unpack_4 (gfc_array_i4 *, const GFC_INTEGER_4 *); +internal_proto(internal_unpack_4); + +extern void internal_unpack_8 (gfc_array_i8 *, const GFC_INTEGER_8 *); +internal_proto(internal_unpack_8); + +#if defined HAVE_GFC_INTEGER_16 +extern void internal_unpack_16 (gfc_array_i16 *, const GFC_INTEGER_16 *); +internal_proto(internal_unpack_16); +#endif + +extern void internal_unpack_c4 (gfc_array_c4 *, const GFC_COMPLEX_4 *); +internal_proto(internal_unpack_c4); + +extern void internal_unpack_c8 (gfc_array_c8 *, const GFC_COMPLEX_8 *); +internal_proto(internal_unpack_c8); + +#if defined HAVE_GFC_COMPLEX_10 +extern void internal_unpack_c10 (gfc_array_c10 *, const GFC_COMPLEX_10 *); +internal_proto(internal_unpack_c10); +#endif + +/* string_intrinsics.c */ + +extern GFC_INTEGER_4 compare_string (GFC_INTEGER_4, const char *, + GFC_INTEGER_4, const char *); +iexport_proto(compare_string); + +/* random.c */ + +extern void random_seed (GFC_INTEGER_4 * size, gfc_array_i4 * put, + gfc_array_i4 * get); +iexport_proto(random_seed); + +/* normalize.c */ + +extern GFC_REAL_4 normalize_r4_i4 (GFC_UINTEGER_4, GFC_UINTEGER_4); +internal_proto(normalize_r4_i4); + +extern GFC_REAL_8 normalize_r8_i8 (GFC_UINTEGER_8, GFC_UINTEGER_8); +internal_proto(normalize_r8_i8); + +/* size.c */ + +typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t; + +extern index_type size0 (const array_t * array); +iexport_proto(size0); + +#endif /* LIBGFOR_H */ diff -uNr dis45.ORIG/2.04/myfnum.F dis45/2.04/myfnum.F --- dis45.ORIG/2.04/myfnum.F 2005-11-25 18:30:08.000000000 +0900 +++ dis45/2.04/myfnum.F 2005-11-24 13:32:31.000000000 +0900 @@ -0,0 +1,4 @@ + integer function myfnum(lun) + myfnum = fnum(lun) + return + end diff -uNr dis45.ORIG/2.04/src/dis45hutil.f dis45/2.04/src/dis45hutil.f --- dis45.ORIG/2.04/src/dis45hutil.f 2005-11-14 23:30:52.000000000 +0900 +++ dis45/2.04/src/dis45hutil.f 2005-11-24 13:32:31.000000000 +0900 @@ -217,11 +217,11 @@ Integer KBITS, IQ Parameter( KBITS = 1, IQ = 18 ) Integer MASK_ERRO, MASK_PERR, MASK_BARX, MASK_NEQB, MASK_PFUN - Parameter( MASK_ERRO = '00000400'X ) ! error - Parameter( MASK_PERR = '40000000'X ) ! print error - Parameter( MASK_BARX = '00000100'X ) ! BARX (has PAKE error) - Parameter( MASK_NEQB = '00000020'X ) ! NEQB (non-equidistant bins) - Parameter( MASK_PFUN = '00000800'X ) ! plot function + Parameter( MASK_ERRO = x'00000400' ) ! error + Parameter( MASK_PERR = x'40000000' ) ! print error + Parameter( MASK_BARX = x'00000100' ) ! BARX (has PAKE error) + Parameter( MASK_NEQB = x'00000020' ) ! NEQB (non-equidistant bins) + Parameter( MASK_PFUN = x'00000800' ) ! plot function C input Integer id Character * (*) opt @@ -272,11 +272,11 @@ Integer KBITS, IQ Parameter( KBITS = 1, IQ = 18 ) Integer MASK_ERRO, MASK_PERR, MASK_BARX, MASK_NEQB, MASK_PFUN - Parameter( MASK_ERRO = '00000400'X ) ! error - Parameter( MASK_PERR = '40000000'X ) ! print error - Parameter( MASK_BARX = '00000100'X ) ! BARX (has PAKE error) - Parameter( MASK_NEQB = '00000020'X ) ! NEQB (non-equidistant bins) - Parameter( MASK_PFUN = '00000800'X ) ! plot function + Parameter( MASK_ERRO = x'00000400' ) ! error + Parameter( MASK_PERR = x'40000000' ) ! print error + Parameter( MASK_BARX = x'00000100' ) ! BARX (has PAKE error) + Parameter( MASK_NEQB = x'00000020' ) ! NEQB (non-equidistant bins) + Parameter( MASK_PFUN = x'00000800' ) ! plot function C input Integer id Character * (*) opt diff -uNr dis45.ORIG/2.04/std/hlpackfun.f dis45/2.04/std/hlpackfun.f --- dis45.ORIG/2.04/std/hlpackfun.f 2005-11-14 01:08:29.000000000 +0900 +++ dis45/2.04/std/hlpackfun.f 2005-11-24 13:32:31.000000000 +0900 @@ -347,7 +347,7 @@ C Call Txtrd('Output file name', minfile) Call DIS45_GETLUN(lunout) - Open (Unit=lunout,name=minfile,Status='NEW',Err=999) + Open (Unit=lunout,File=minfile,Status='NEW',Err=999) c Write(lunout,'(A)') title DO i=1,numparam diff -uNr dis45.ORIG/2.04/unix.h dis45/2.04/unix.h --- dis45.ORIG/2.04/unix.h 2005-11-28 15:38:55.000000000 +0900 +++ dis45/2.04/unix.h 2005-11-28 15:34:31.000000000 +0900 @@ -0,0 +1,63 @@ +/* Copyright (C) 2002, 2003, 2004, 2005 + Free Software Foundation, Inc. + Contributed by Andy Vaught + +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 General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +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 General Public License for more details. + +You should have received a copy of the GNU General Public License +along with Libgfortran; see the file COPYING. If not, write to +the Free Software Foundation, 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +/* Unix stream I/O module */ + +#define BUFFER_SIZE 8192 + +typedef struct +{ + stream st; + + int fd; + gfc_offset buffer_offset; /* File offset of the start of the buffer */ + gfc_offset physical_offset; /* Current physical file offset */ + gfc_offset logical_offset; /* Current logical file offset */ + gfc_offset dirty_offset; /* Start of modified bytes in buffer */ + gfc_offset file_length; /* Length of the file, -1 if not seekable. */ + + char *buffer; + int len; /* Physical length of the current buffer */ + int active; /* Length of valid bytes in the buffer */ + + int prot; + int ndirty; /* Dirty bytes starting at dirty_offset */ + + int special_file; /* =1 if the fd refers to a special file */ + + unsigned unbuffered:1; + + char small_buffer[BUFFER_SIZE]; + +} +unix_stream; + +extern stream *init_error_stream (unix_stream *); +internal_proto(init_error_stream);