mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
gnu: ghc-4: Build full compiler using provided *.hc files.
* gnu/packages/haskell.scm (ghc-4)[source]: Remove patch. [arguments]: Change to build full compiler. [native-inputs]: Remove default binutils and gcc; add tarball for hc files. * gnu/packages/patches/ghc-4.patch: Delete patch. * gnu/local.mk (dist_patch_DATA): Remove it.
This commit is contained in:
Ricardo Wurmus
parent
bbaf3bcb45
commit
82791af033
3 changed files with 167 additions and 870 deletions
|
|
@ -1187,7 +1187,6 @@ dist_patch_DATA = \
|
||||||
%D%/packages/patches/gemmi-fix-sajson-types.patch \
|
%D%/packages/patches/gemmi-fix-sajson-types.patch \
|
||||||
%D%/packages/patches/genimage-mke2fs-test.patch \
|
%D%/packages/patches/genimage-mke2fs-test.patch \
|
||||||
%D%/packages/patches/geoclue-config.patch \
|
%D%/packages/patches/geoclue-config.patch \
|
||||||
%D%/packages/patches/ghc-4.patch \
|
|
||||||
%D%/packages/patches/ghc-8.0-fall-back-to-madv_dontneed.patch \
|
%D%/packages/patches/ghc-8.0-fall-back-to-madv_dontneed.patch \
|
||||||
%D%/packages/patches/ghc-testsuite-dlopen-pie.patch \
|
%D%/packages/patches/ghc-testsuite-dlopen-pie.patch \
|
||||||
%D%/packages/patches/ghc-language-haskell-extract-ghc-8.10.patch \
|
%D%/packages/patches/ghc-language-haskell-extract-ghc-8.10.patch \
|
||||||
|
|
|
||||||
|
|
@ -192,185 +192,191 @@ is itself quite fast.")
|
||||||
version "/" name "-" version "-src.tar.bz2"))
|
version "/" name "-" version "-src.tar.bz2"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0ar4nxy4cr5vwvfj71gmc174vx0n3lg9ka05sa1k60c8z0g3xp1q"))
|
"0ar4nxy4cr5vwvfj71gmc174vx0n3lg9ka05sa1k60c8z0g3xp1q"))))
|
||||||
(patches (search-patches "ghc-4.patch"))))
|
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(supported-systems '("i686-linux" "x86_64-linux"))
|
(supported-systems '("i686-linux" "x86_64-linux"))
|
||||||
(arguments
|
(arguments
|
||||||
`(#:system "i686-linux"
|
(list
|
||||||
#:strip-binaries? #f
|
#:system "i686-linux"
|
||||||
#:phases
|
#:strip-binaries? #f
|
||||||
(modify-phases %standard-phases
|
#:parallel-build? #f
|
||||||
(replace 'bootstrap
|
#:implicit-inputs? #f
|
||||||
(lambda* (#:key inputs #:allow-other-keys)
|
#:modules '((guix build gnu-build-system)
|
||||||
(delete-file "configure")
|
(guix build utils)
|
||||||
(delete-file "config.sub")
|
(srfi srfi-1)
|
||||||
(install-file (search-input-file inputs
|
(ice-9 match))
|
||||||
"/bin/config.sub")
|
#:phases
|
||||||
".")
|
#~(modify-phases %standard-phases
|
||||||
|
(add-after 'unpack 'unpack-generated-c-code
|
||||||
|
(lambda* (#:key inputs #:allow-other-keys)
|
||||||
|
(let ((tarball
|
||||||
|
(match inputs
|
||||||
|
(((_ . locations) ...)
|
||||||
|
(let ((suffix (string-append "ghc-"
|
||||||
|
#$(package-version this-package)
|
||||||
|
"-x86-hc.tar.bz2")))
|
||||||
|
(find (lambda (location)
|
||||||
|
(string-suffix? suffix location))
|
||||||
|
locations))))))
|
||||||
|
(invoke "tar" "-xvf" tarball
|
||||||
|
"--strip-components=1"))))
|
||||||
|
(replace 'bootstrap
|
||||||
|
(lambda* (#:key inputs #:allow-other-keys)
|
||||||
|
(delete-file "configure")
|
||||||
|
(delete-file "config.sub")
|
||||||
|
(install-file (search-input-file inputs
|
||||||
|
"/bin/config.sub")
|
||||||
|
".")
|
||||||
|
|
||||||
;; Avoid dependency on "happy"
|
;; Avoid dependency on "happy"
|
||||||
(substitute* "configure.in"
|
(substitute* "configure.in"
|
||||||
(("FPTOOLS_HAPPY") "echo sure\n"))
|
(("FPTOOLS_HAPPY") "echo sure\n"))
|
||||||
|
|
||||||
;; Set options suggested in ghc/interpreter/README.BUILDING.HUGS.
|
(let ((bash (which "bash")))
|
||||||
(with-output-to-file "mk/build.mk"
|
(substitute* '("configure.in"
|
||||||
(lambda ()
|
"ghc/configure.in"
|
||||||
(display "
|
"ghc/rts/gmp/mpn/configure.in"
|
||||||
WithGhcHc=ghc-4.06
|
"ghc/rts/gmp/mpz/configure.in"
|
||||||
GhcLibWays=u
|
"ghc/rts/gmp/configure.in"
|
||||||
#HsLibsFor=hugs
|
"distrib/configure-bin.in")
|
||||||
# Setting this leads to building the interpreter.
|
(("`/bin/sh") (string-append "`" bash))
|
||||||
|
(("SHELL=/bin/sh") (string-append "SHELL=" bash))
|
||||||
|
(("^#! /bin/sh") (string-append "#! " bash)))
|
||||||
|
|
||||||
|
(substitute* '("mk/config.mk.in"
|
||||||
|
"ghc/rts/gmp/mpz/Makefile.in"
|
||||||
|
"ghc/rts/gmp/Makefile.in")
|
||||||
|
(("^SHELL.*=.*/bin/sh") (string-append "SHELL = " bash)))
|
||||||
|
(substitute* "aclocal.m4"
|
||||||
|
(("SHELL=/bin/sh") (string-append "SHELL=" bash)))
|
||||||
|
(substitute* '("ghc/lib/std/cbits/system.c"
|
||||||
|
"hslibs/posix/cbits/execvpe.c")
|
||||||
|
(("/bin/sh") bash)
|
||||||
|
(("\"sh\"") (string-append "\"" bash "\"")))
|
||||||
|
|
||||||
|
(setenv "CONFIG_SHELL" bash)
|
||||||
|
(setenv "SHELL" bash))
|
||||||
|
|
||||||
|
;; The 'hscpp' script invokes GCC 2.95's 'cpp' (RAWCPP), which
|
||||||
|
;; segfaults unless passed '-x c'.
|
||||||
|
(substitute* "mk/config.mk.in"
|
||||||
|
(("-traditional")
|
||||||
|
"-traditional -x c"))
|
||||||
|
|
||||||
|
(setenv "CPP" (which "cpp"))
|
||||||
|
(invoke "autoreconf" "--verbose" "--force")))
|
||||||
|
(add-before 'configure 'configure-gmp
|
||||||
|
(lambda _
|
||||||
|
(with-directory-excursion "ghc/rts/gmp"
|
||||||
|
(invoke "./configure"))))
|
||||||
|
(replace 'configure
|
||||||
|
(lambda* (#:key build #:allow-other-keys)
|
||||||
|
(call-with-output-file "config.cache"
|
||||||
|
(lambda (port)
|
||||||
|
;; GCC 2.95 fails to deal with anonymous unions in glibc's
|
||||||
|
;; 'struct_rusage.h', so skip that.
|
||||||
|
(display "ac_cv_func_getrusage=no\n" port)))
|
||||||
|
|
||||||
|
;; CLK_TCK has been removed from recent libc.
|
||||||
|
(substitute* "ghc/interpreter/nHandle.c"
|
||||||
|
(("CLK_TCK") "sysconf (_SC_CLK_TCK)"))
|
||||||
|
;; Avoid duplicate definitions of execvpe
|
||||||
|
(substitute* "ghc/lib/std/cbits/stgio.h"
|
||||||
|
(("^int.*execvpe.*") ""))
|
||||||
|
;; gid_t is an undefined type
|
||||||
|
(substitute* "hslibs/posix/PosixProcEnv.lhs"
|
||||||
|
(("gid_t") "int"))
|
||||||
|
|
||||||
|
;; This is needed so that ghc/includes/Stg.h can see config.h,
|
||||||
|
;; which defines values that are important for
|
||||||
|
;; ghc/includes/StgTypes.h and others.
|
||||||
|
(setenv "CPATH"
|
||||||
|
(string-append (getcwd) "/ghc/includes:"
|
||||||
|
(getcwd) "/ghc/rts/gmp:"
|
||||||
|
(getcwd) "/mk:"
|
||||||
|
(or (getenv "CPATH") "")))
|
||||||
|
|
||||||
|
(with-output-to-file "mk/build.mk"
|
||||||
|
(lambda ()
|
||||||
|
(display "
|
||||||
|
ProjectsToBuild = glafp-utils hslibs ghc
|
||||||
|
GhcLibWays=
|
||||||
GhcHcOpts=-DDEBUG
|
GhcHcOpts=-DDEBUG
|
||||||
GhcRtsHcOpts=-optc-DDEBUG -optc-D__HUGS__ -unreg -optc-g -optc-D_GNU_SOURCE=1
|
GhcLibHcOpts= -O
|
||||||
GhcRtsCcOpts=-optc-DDEBUG -optc-g -optc-D__HUGS__ -optc-D_GNU_SOURCE=1
|
GhcRtsHcOpts=-optc-D_GNU_SOURCE=1 -optc-DDEBUG
|
||||||
SplitObjs=NO
|
GhcRtsCcOpts=-optc-D_GNU_SOURCE=1 -optc-DDEBUG
|
||||||
|
SplitObjs=YES
|
||||||
|
GhcWithHscBuiltViaC=YES
|
||||||
")))
|
")))
|
||||||
|
(invoke "./configure"
|
||||||
(substitute* "ghc/interpreter/interface.c"
|
"--enable-hc-boot" ; boot from C "source" files
|
||||||
;; interface.c:2702: `stackOverflow' redeclared as different kind of symbol
|
(string-append "--prefix=" #$output)
|
||||||
;; ../includes/Stg.h:188: previous declaration of `stackOverflow'
|
(string-append "--build=" build)
|
||||||
((".*Sym\\(stackOverflow\\).*") "")
|
(string-append "--host=" build))))
|
||||||
;; interface.c:2713: `stg_error_entry' undeclared here (not in a function)
|
;; Build hsc
|
||||||
;; interface.c:2713: initializer element is not constant
|
(add-before 'build 'make-boot
|
||||||
;; interface.c:2713: (near initialization for `rtsTab[11].ad')
|
(lambda _
|
||||||
((".*SymX\\(stg_error_entry\\).*") "")
|
;; Avoid calling happy
|
||||||
;; interface.c:2713: `Upd_frame_info' undeclared here (not in a function)
|
(invoke "touch" "ghc/compiler/rename/ParseIface.hs")
|
||||||
;; interface.c:2713: initializer element is not constant
|
(invoke "touch" "ghc/compiler/parser/Parser.hs")
|
||||||
;; interface.c:2713: (near initialization for `rtsTab[32].ad')
|
(invoke "make" "boot" "all")))
|
||||||
((".*SymX\\(Upd_frame_info\\).*") ""))
|
;; Build libraries
|
||||||
|
(replace 'build
|
||||||
;; We need to use the absolute file names here or else the linker
|
(lambda _
|
||||||
;; will complain about missing symbols. Perhaps this could be
|
;; Build these from their Haskell sources.
|
||||||
;; avoided by modifying the library search path in a way that
|
(invoke "sh" "-c" "echo GhcWithHscBuiltViaC=NO >>mk/build.mk")
|
||||||
;; this old linker understands.
|
(with-directory-excursion "ghc/lib"
|
||||||
(substitute* "ghc/interpreter/Makefile"
|
(invoke "make" "clean" "boot" "all"))
|
||||||
(("-lbfd -liberty")
|
(with-directory-excursion "hslibs"
|
||||||
(string-append (search-input-file inputs "/lib/libbfd.a") " "
|
(invoke "make" "clean" "boot" "all"))))
|
||||||
(search-input-file inputs "/lib/libiberty.a"))))
|
(add-before 'install 'do-not-strip
|
||||||
|
(lambda _
|
||||||
(let ((bash (which "bash")))
|
(substitute* '("install-sh"
|
||||||
(substitute* '("configure.in"
|
"ghc/rts/gmp/install.sh")
|
||||||
"ghc/configure.in"
|
(("^stripprog=.*") "stripprog=echo\n"))
|
||||||
"ghc/rts/gmp/mpn/configure.in"
|
(substitute* "mk/opts.mk"
|
||||||
"ghc/rts/gmp/mpz/configure.in"
|
(("^SRC_INSTALL_BIN_OPTS.*") "")))))))
|
||||||
"ghc/rts/gmp/configure.in"
|
|
||||||
"distrib/configure-bin.in")
|
|
||||||
(("`/bin/sh") (string-append "`" bash))
|
|
||||||
(("SHELL=/bin/sh") (string-append "SHELL=" bash))
|
|
||||||
(("^#! /bin/sh") (string-append "#! " bash)))
|
|
||||||
|
|
||||||
(substitute* '("mk/config.mk.in"
|
|
||||||
"ghc/rts/gmp/mpz/Makefile.in"
|
|
||||||
"ghc/rts/gmp/Makefile.in")
|
|
||||||
(("^SHELL.*=.*/bin/sh") (string-append "SHELL = " bash)))
|
|
||||||
(substitute* "aclocal.m4"
|
|
||||||
(("SHELL=/bin/sh") (string-append "SHELL=" bash)))
|
|
||||||
|
|
||||||
(setenv "CONFIG_SHELL" bash)
|
|
||||||
(setenv "SHELL" bash))
|
|
||||||
|
|
||||||
;; The 'hscpp' script invokes GCC 2.95's 'cpp' (RAWCPP), which
|
|
||||||
;; segfaults unless passed '-x c'.
|
|
||||||
(substitute* "mk/config.mk.in"
|
|
||||||
(("-traditional")
|
|
||||||
"-traditional -x c"))
|
|
||||||
|
|
||||||
(setenv "CPP" (which "cpp"))
|
|
||||||
(invoke "autoreconf" "--verbose" "--force")))
|
|
||||||
(add-before 'configure 'configure-gmp
|
|
||||||
(lambda* (#:key build inputs outputs #:allow-other-keys)
|
|
||||||
(with-directory-excursion "ghc/rts/gmp"
|
|
||||||
(let ((bash (which "bash"))
|
|
||||||
(out (assoc-ref outputs "out")))
|
|
||||||
(invoke bash "./configure")))))
|
|
||||||
(replace 'configure
|
|
||||||
(lambda* (#:key build inputs outputs #:allow-other-keys)
|
|
||||||
(let ((bash (which "bash"))
|
|
||||||
(out (assoc-ref outputs "out")))
|
|
||||||
(call-with-output-file "config.cache"
|
|
||||||
(lambda (port)
|
|
||||||
;; GCC 2.95 fails to deal with anonymous unions in glibc's
|
|
||||||
;; 'struct_rusage.h', so skip that.
|
|
||||||
(display "ac_cv_func_getrusage=no\n" port)))
|
|
||||||
|
|
||||||
(invoke bash "./configure"
|
|
||||||
"--enable-hc-boot"
|
|
||||||
(string-append "--prefix=" out)
|
|
||||||
(string-append "--build=" build)
|
|
||||||
(string-append "--host=" build)))))
|
|
||||||
(add-before 'build 'make-boot
|
|
||||||
(lambda _
|
|
||||||
;; CLK_TCK has been removed from recent libc.
|
|
||||||
(substitute* "ghc/interpreter/nHandle.c"
|
|
||||||
(("CLK_TCK") "sysconf (_SC_CLK_TCK)"))
|
|
||||||
|
|
||||||
;; Only when building with more recent GCC
|
|
||||||
(when #false
|
|
||||||
;; GCC 2.95 is fine with these comments, but GCC 4.6 is not.
|
|
||||||
(substitute* "ghc/rts/universal_call_c.S"
|
|
||||||
(("^# .*") "")))
|
|
||||||
|
|
||||||
;; Only when using more recent Perl
|
|
||||||
(when #false
|
|
||||||
(substitute* "ghc/driver/ghc-asm.prl"
|
|
||||||
(("local\\(\\$\\*\\) = 1;") "")
|
|
||||||
(("endef\\$/") "endef$/s")))
|
|
||||||
|
|
||||||
(setenv "CPATH"
|
|
||||||
(string-append (getcwd) "/ghc/includes:"
|
|
||||||
(getcwd) "/mk:"
|
|
||||||
(or (getenv "CPATH") "")))
|
|
||||||
(invoke "make" "boot")))
|
|
||||||
(replace 'build
|
|
||||||
(lambda _
|
|
||||||
;; TODO: since we don't have a Haskell compiler we cannot build
|
|
||||||
;; the standard library. And without the standard library we
|
|
||||||
;; cannot build a Haskell compiler.
|
|
||||||
;; make[3]: *** No rule to make target 'Array.o', needed by 'libHSstd.a'. Stop.
|
|
||||||
;; make[2]: *** No rule to make target 'utils/Argv.o', needed by 'hsc'. Stop.
|
|
||||||
(invoke "make" "all")))
|
|
||||||
(add-after 'build 'build-hugs
|
|
||||||
(lambda _
|
|
||||||
(invoke "make" "-C" "ghc/interpreter")
|
|
||||||
(invoke "make" "-C" "ghc/interpreter" "install")))
|
|
||||||
(add-after 'install 'install-sources
|
|
||||||
(lambda* (#:key outputs #:allow-other-keys)
|
|
||||||
(let ((lib (string-append (assoc-ref outputs "out") "/lib")))
|
|
||||||
(copy-recursively "hslibs"
|
|
||||||
(string-append lib "/hslibs"))
|
|
||||||
(copy-recursively "ghc/lib"
|
|
||||||
(string-append lib "/ghc/lib"))
|
|
||||||
(copy-recursively "ghc/compiler"
|
|
||||||
(string-append lib "/ghc/compiler"))
|
|
||||||
(copy-recursively "ghc/interpreter/lib" lib)
|
|
||||||
(install-file "ghc/interpreter/nHandle.so" lib)))))))
|
|
||||||
(native-inputs
|
(native-inputs
|
||||||
(list autoconf-2.13
|
(modify-inputs (%final-inputs)
|
||||||
bison ;for parser.y
|
(delete "binutils" "gcc")
|
||||||
|
(prepend
|
||||||
|
autoconf-2.13
|
||||||
|
bison ;for parser.y
|
||||||
config
|
config
|
||||||
|
|
||||||
;; Needed to support lvalue casts.
|
|
||||||
gcc-2.95
|
|
||||||
|
|
||||||
;; Use an older assembler to work around this error in GMP:
|
;; Use an older assembler to work around this error in GMP:
|
||||||
;; Error: `%edx' not allowed with `testb'
|
;; Error: `%edx' not allowed with `testb'
|
||||||
binutils-2.33
|
binutils-2.33
|
||||||
|
|
||||||
;; TODO: Perl used to allow setting $* to enable multi-line
|
;; Needed to support lvalue casts.
|
||||||
;; matching. If we want to use a more recent Perl we need to patch
|
gcc-2.95
|
||||||
;; all expressions that require multi-line matching. Hard to tell.
|
|
||||||
perl-5.6))
|
;; Perl used to allow setting $* to enable multi-line matching. If
|
||||||
|
;; we want to use a more recent Perl we need to patch all
|
||||||
|
;; expressions that require multi-line matching. Hard to tell.
|
||||||
|
perl-5.6
|
||||||
|
|
||||||
|
;; This is the secret sauce. These files are macro-heavy C
|
||||||
|
;; "source" files that are used to build hsc from C. They are
|
||||||
|
;; presumably the output of previous versions of GHC. Note that
|
||||||
|
;; this is the "registerized" variant for x86. An "unreg" variant
|
||||||
|
;; of the *.hc files also exists for building GHC for other
|
||||||
|
;; architectures. The default "way" (see GhcLibWays above) to
|
||||||
|
;; build and link the GHC binaries, however, is not the
|
||||||
|
;; unregisterized variant. Using the unregisterized *.hc files
|
||||||
|
;; with a standard build will result in segfaults.
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "http://downloads.haskell.org/~ghc/"
|
||||||
|
version "/ghc-" version "-x86-hc.tar.bz2"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0fi60bj0ak391x31cq5wp1ffwavl5w9jffyf62yv9rhxa915596b"))))))
|
||||||
(home-page "https://www.haskell.org/ghc")
|
(home-page "https://www.haskell.org/ghc")
|
||||||
(synopsis "The Glasgow Haskell Compiler")
|
(synopsis "The Glasgow Haskell Compiler")
|
||||||
(description
|
(description
|
||||||
"The Glasgow Haskell Compiler (GHC) is a state-of-the-art compiler and
|
"The Glasgow Haskell Compiler (GHC) is a state-of-the-art compiler and
|
||||||
interactive environment for the functional language Haskell. The value of
|
interactive environment for the functional language Haskell.")
|
||||||
this package lies in the modified build of Hugs that is linked with GHC's STG
|
|
||||||
runtime system, the RTS. \"STG\" stands for \"spineless, tagless,
|
|
||||||
G-machine\"; it is the abstract machine designed to support nonstrict
|
|
||||||
higher-order functional languages. Neither the compiler nor the Haskell
|
|
||||||
libraries are included in this package.")
|
|
||||||
(license license:bsd-3)))
|
(license license:bsd-3)))
|
||||||
|
|
||||||
(define ghc-bootstrap-x86_64-7.8.4
|
(define ghc-bootstrap-x86_64-7.8.4
|
||||||
|
|
|
||||||
|
|
@ -1,708 +0,0 @@
|
||||||
The GHC 4 runtime system was written before GCC 3.5 deprecated lvalue casts.
|
|
||||||
The runtime system's sources are littered with these casts, so early versions
|
|
||||||
of this patch were dedicated to rewriting those statements to a standards
|
|
||||||
compliant form. Unfortunately, this led to subtle breakage, so instead we
|
|
||||||
build with GCC 2.95.
|
|
||||||
|
|
||||||
Problematic for newer versions of GCC is also the assembly in the bundled
|
|
||||||
sources of GMP 2.0.2, which spans multiple lines without escaping line breaks.
|
|
||||||
|
|
||||||
TODO: We aren't yet using anything under ghc/compiler, so the patches there
|
|
||||||
aren't needed at this time. The intent was to ensure that the compiler
|
|
||||||
sources can be used even when they are interpreted by Hugs.
|
|
||||||
|
|
||||||
TODO: There are some more problems with the Haskell sources. Some files have
|
|
||||||
too many commas (both at the end of the line and at the beginning of the next
|
|
||||||
line). Others use a trailing hash, which Hugs doesn't understand.
|
|
||||||
|
|
||||||
TODO: Hugs doesn't understand "unsafe" in hslib/lang/Storable.lhs
|
|
||||||
|
|
||||||
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
|
|
||||||
index ca1b58d..074fcaf 100644
|
|
||||||
--- a/ghc/compiler/main/CmdLineOpts.lhs
|
|
||||||
+++ b/ghc/compiler/main/CmdLineOpts.lhs
|
|
||||||
@@ -163,9 +163,9 @@ import Constants -- Default values for some flags
|
|
||||||
|
|
||||||
import FastString ( headFS )
|
|
||||||
import Maybes ( assocMaybe, firstJust, maybeToBool )
|
|
||||||
-import Panic ( panic, panic# )
|
|
||||||
+import Panic ( panic, panic' )
|
|
||||||
|
|
||||||
-#if __GLASGOW_HASKELL__ < 301
|
|
||||||
+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 301
|
|
||||||
import ArrBase ( Array(..) )
|
|
||||||
#else
|
|
||||||
import PrelArr ( Array(..) )
|
|
||||||
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
|
|
||||||
index 7a0627d..59802c4 100644
|
|
||||||
--- a/ghc/compiler/prelude/PrimOp.lhs
|
|
||||||
+++ b/ghc/compiler/prelude/PrimOp.lhs
|
|
||||||
@@ -502,7 +502,7 @@ tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(260)
|
|
||||||
tagOf_PrimOp DataToTagOp = ILIT(261)
|
|
||||||
tagOf_PrimOp TagToEnumOp = ILIT(262)
|
|
||||||
|
|
||||||
-tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
|
|
||||||
+tagOf_PrimOp op = pprPanic' "tagOf_PrimOp: pattern-match" (ppr op)
|
|
||||||
|
|
||||||
instance Eq PrimOp where
|
|
||||||
op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
|
|
||||||
diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
|
|
||||||
index 19ad666..89d07cb 100644
|
|
||||||
--- a/ghc/compiler/utils/Outputable.lhs
|
|
||||||
+++ b/ghc/compiler/utils/Outputable.lhs
|
|
||||||
@@ -42,8 +42,8 @@ module Outputable (
|
|
||||||
|
|
||||||
|
|
||||||
-- error handling
|
|
||||||
- pprPanic, pprPanic#, pprError, pprTrace, assertPprPanic, warnPprTrace,
|
|
||||||
- trace, panic, panic#, assertPanic
|
|
||||||
+ pprPanic, pprPanic', pprError, pprTrace, assertPprPanic, warnPprTrace,
|
|
||||||
+ trace, panic, panic', assertPanic
|
|
||||||
) where
|
|
||||||
|
|
||||||
#include "HsVersions.h"
|
|
||||||
@@ -420,7 +420,7 @@ pprPanic = pprAndThen panic
|
|
||||||
pprError = pprAndThen error
|
|
||||||
pprTrace = pprAndThen trace
|
|
||||||
|
|
||||||
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
|
|
||||||
+pprPanic' heading pretty_msg = panic' (show (doc PprDebug))
|
|
||||||
where
|
|
||||||
doc = text heading <+> pretty_msg
|
|
||||||
|
|
||||||
diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs
|
|
||||||
index 907d8aa..37a2d87 100644
|
|
||||||
--- a/ghc/compiler/utils/Panic.lhs
|
|
||||||
+++ b/ghc/compiler/utils/Panic.lhs
|
|
||||||
@@ -9,7 +9,7 @@ It's hard to put these functions anywhere else without causing
|
|
||||||
some unnecessary loops in the module dependency graph.
|
|
||||||
|
|
||||||
\begin{code}
|
|
||||||
-module Panic ( panic, panic#, assertPanic, trace ) where
|
|
||||||
+module Panic ( panic, panic', assertPanic, trace ) where
|
|
||||||
|
|
||||||
import IOExts ( trace )
|
|
||||||
|
|
||||||
@@ -27,8 +27,8 @@ panic x = error ("panic! (the `impossible' happened):\n\t"
|
|
||||||
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
|
|
||||||
-- No, man -- Too Beautiful! (Will)
|
|
||||||
|
|
||||||
-panic# :: String -> FAST_INT
|
|
||||||
-panic# s = case (panic s) of () -> ILIT(0)
|
|
||||||
+panic' :: String -> FAST_INT
|
|
||||||
+panic' s = case (panic s) of () -> ILIT(0)
|
|
||||||
|
|
||||||
assertPanic :: String -> Int -> a
|
|
||||||
assertPanic file line = panic ("ASSERT failed! file " ++ file ++ ", line " ++ show line)
|
|
||||||
diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
|
|
||||||
index 8b8c2f9..7f43ab0 100644
|
|
||||||
--- a/ghc/includes/PrimOps.h
|
|
||||||
+++ b/ghc/includes/PrimOps.h
|
|
||||||
@@ -893,6 +893,7 @@ EXTFUN_RTS(mkForeignObjzh_fast);
|
|
||||||
#define STG_SIG_ERR (-3)
|
|
||||||
#define STG_SIG_HAN (-4)
|
|
||||||
|
|
||||||
+#include <signal.h>
|
|
||||||
extern StgInt sig_install (StgInt, StgInt, StgStablePtr, sigset_t *);
|
|
||||||
#define stg_sig_default(sig,mask) sig_install(sig,STG_SIG_DFL,0,(sigset_t *)mask)
|
|
||||||
#define stg_sig_ignore(sig,mask) sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask)
|
|
||||||
diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
|
|
||||||
index a05036f..9cd6c83 100644
|
|
||||||
--- a/ghc/rts/RtsFlags.c
|
|
||||||
+++ b/ghc/rts/RtsFlags.c
|
|
||||||
@@ -1132,8 +1132,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error)
|
|
||||||
} else if (RtsFlags.GranFlags.proc > MAX_PROC ||
|
|
||||||
RtsFlags.GranFlags.proc < 1)
|
|
||||||
{
|
|
||||||
- fprintf(stderr,"setupRtsFlags: no more than %u processors
|
|
||||||
-allowed\n",
|
|
||||||
+ fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n",
|
|
||||||
MAX_PROC);
|
|
||||||
*error = rtsTrue;
|
|
||||||
}
|
|
||||||
diff --git a/ghc/rts/gmp/longlong.h b/ghc/rts/gmp/longlong.h
|
|
||||||
index 382fcc0..0cf79fa 100644
|
|
||||||
--- a/ghc/rts/gmp/longlong.h
|
|
||||||
+++ b/ghc/rts/gmp/longlong.h
|
|
||||||
@@ -106,7 +106,7 @@ MA 02111-1307, USA. */
|
|
||||||
|
|
||||||
#if (defined (__a29k__) || defined (_AM29K)) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("add %1,%4,%5
|
|
||||||
+ __asm__ ("add %1,%4,%5\n\
|
|
||||||
addc %0,%2,%3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -115,7 +115,7 @@ MA 02111-1307, USA. */
|
|
||||||
"%r" ((USItype)(al)), \
|
|
||||||
"rI" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("sub %1,%4,%5
|
|
||||||
+ __asm__ ("sub %1,%4,%5\n\
|
|
||||||
subc %0,%2,%3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -173,7 +173,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__arm__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("adds %1, %4, %5
|
|
||||||
+ __asm__ ("adds %1, %4, %5\n\
|
|
||||||
adc %0, %2, %3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -182,7 +182,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
"%r" ((USItype)(al)), \
|
|
||||||
"rI" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subs %1, %4, %5
|
|
||||||
+ __asm__ ("subs %1, %4, %5\n\
|
|
||||||
sbc %0, %2, %3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -191,18 +191,18 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
"r" ((USItype)(al)), \
|
|
||||||
"rI" ((USItype)(bl)))
|
|
||||||
#define umul_ppmm(xh, xl, a, b) \
|
|
||||||
- __asm__ ("%@ Inlined umul_ppmm
|
|
||||||
- mov %|r0, %2, lsr #16
|
|
||||||
- mov %|r2, %3, lsr #16
|
|
||||||
- bic %|r1, %2, %|r0, lsl #16
|
|
||||||
- bic %|r2, %3, %|r2, lsl #16
|
|
||||||
- mul %1, %|r1, %|r2
|
|
||||||
- mul %|r2, %|r0, %|r2
|
|
||||||
- mul %|r1, %0, %|r1
|
|
||||||
- mul %0, %|r0, %0
|
|
||||||
- adds %|r1, %|r2, %|r1
|
|
||||||
- addcs %0, %0, #65536
|
|
||||||
- adds %1, %1, %|r1, lsl #16
|
|
||||||
+ __asm__ ("%@ Inlined umul_ppmm\n\
|
|
||||||
+ mov %|r0, %2, lsr #16\n\
|
|
||||||
+ mov %|r2, %3, lsr #16\n\
|
|
||||||
+ bic %|r1, %2, %|r0, lsl #16\n\
|
|
||||||
+ bic %|r2, %3, %|r2, lsl #16\n\
|
|
||||||
+ mul %1, %|r1, %|r2\n\
|
|
||||||
+ mul %|r2, %|r0, %|r2\n\
|
|
||||||
+ mul %|r1, %0, %|r1\n\
|
|
||||||
+ mul %0, %|r0, %0\n\
|
|
||||||
+ adds %|r1, %|r2, %|r1\n\
|
|
||||||
+ addcs %0, %0, #65536\n\
|
|
||||||
+ adds %1, %1, %|r1, lsl #16\n\
|
|
||||||
adc %0, %0, %|r1, lsr #16" \
|
|
||||||
: "=&r" ((USItype)(xh)), \
|
|
||||||
"=r" ((USItype)(xl)) \
|
|
||||||
@@ -243,7 +243,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__gmicro__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("add.w %5,%1
|
|
||||||
+ __asm__ ("add.w %5,%1\n\
|
|
||||||
addx %3,%0" \
|
|
||||||
: "=g" ((USItype)(sh)), \
|
|
||||||
"=&g" ((USItype)(sl)) \
|
|
||||||
@@ -252,7 +252,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"g" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("sub.w %5,%1
|
|
||||||
+ __asm__ ("sub.w %5,%1\n\
|
|
||||||
subx %3,%0" \
|
|
||||||
: "=g" ((USItype)(sh)), \
|
|
||||||
"=&g" ((USItype)(sl)) \
|
|
||||||
@@ -282,7 +282,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__hppa) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("add %4,%5,%1
|
|
||||||
+ __asm__ ("add %4,%5,%1\n\
|
|
||||||
addc %2,%3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -291,7 +291,7 @@ extern UDItype __udiv_qrnnd ();
|
|
||||||
"%rM" ((USItype)(al)), \
|
|
||||||
"rM" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("sub %4,%5,%1
|
|
||||||
+ __asm__ ("sub %4,%5,%1\n\
|
|
||||||
subb %2,%3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -330,21 +330,21 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
do { \
|
|
||||||
USItype __tmp; \
|
|
||||||
__asm__ ( \
|
|
||||||
- "ldi 1,%0
|
|
||||||
- extru,= %1,15,16,%%r0 ; Bits 31..16 zero?
|
|
||||||
- extru,tr %1,15,16,%1 ; No. Shift down, skip add.
|
|
||||||
- ldo 16(%0),%0 ; Yes. Perform add.
|
|
||||||
- extru,= %1,23,8,%%r0 ; Bits 15..8 zero?
|
|
||||||
- extru,tr %1,23,8,%1 ; No. Shift down, skip add.
|
|
||||||
- ldo 8(%0),%0 ; Yes. Perform add.
|
|
||||||
- extru,= %1,27,4,%%r0 ; Bits 7..4 zero?
|
|
||||||
- extru,tr %1,27,4,%1 ; No. Shift down, skip add.
|
|
||||||
- ldo 4(%0),%0 ; Yes. Perform add.
|
|
||||||
- extru,= %1,29,2,%%r0 ; Bits 3..2 zero?
|
|
||||||
- extru,tr %1,29,2,%1 ; No. Shift down, skip add.
|
|
||||||
- ldo 2(%0),%0 ; Yes. Perform add.
|
|
||||||
- extru %1,30,1,%1 ; Extract bit 1.
|
|
||||||
- sub %0,%1,%0 ; Subtract it.
|
|
||||||
+ "ldi 1,%0\n\
|
|
||||||
+ extru,= %1,15,16,%%r0 ; Bits 31..16 zero?\n\
|
|
||||||
+ extru,tr %1,15,16,%1 ; No. Shift down, skip add.\n\
|
|
||||||
+ ldo 16(%0),%0 ; Yes. Perform add.\n\
|
|
||||||
+ extru,= %1,23,8,%%r0 ; Bits 15..8 zero?\n\
|
|
||||||
+ extru,tr %1,23,8,%1 ; No. Shift down, skip add.\n\
|
|
||||||
+ ldo 8(%0),%0 ; Yes. Perform add.\n\
|
|
||||||
+ extru,= %1,27,4,%%r0 ; Bits 7..4 zero?\n\
|
|
||||||
+ extru,tr %1,27,4,%1 ; No. Shift down, skip add.\n\
|
|
||||||
+ ldo 4(%0),%0 ; Yes. Perform add.\n\
|
|
||||||
+ extru,= %1,29,2,%%r0 ; Bits 3..2 zero?\n\
|
|
||||||
+ extru,tr %1,29,2,%1 ; No. Shift down, skip add.\n\
|
|
||||||
+ ldo 2(%0),%0 ; Yes. Perform add.\n\
|
|
||||||
+ extru %1,30,1,%1 ; Extract bit 1.\n\
|
|
||||||
+ sub %0,%1,%0 ; Subtract it.\n\
|
|
||||||
" : "=r" (count), "=r" (__tmp) : "1" (x)); \
|
|
||||||
} while (0)
|
|
||||||
#endif /* hppa */
|
|
||||||
@@ -392,7 +392,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if (defined (__i386__) || defined (__i486__)) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("addl %5,%1
|
|
||||||
+ __asm__ ("addl %5,%1\n\
|
|
||||||
adcl %3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -401,7 +401,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"g" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subl %5,%1
|
|
||||||
+ __asm__ ("subl %5,%1\n\
|
|
||||||
sbbl %3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -514,7 +514,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if (defined (__mc68000__) || defined (__mc68020__) || defined (__NeXT__) || defined(mc68020)) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("add%.l %5,%1
|
|
||||||
+ __asm__ ("add%.l %5,%1\n\
|
|
||||||
addx%.l %3,%0" \
|
|
||||||
: "=d" ((USItype)(sh)), \
|
|
||||||
"=&d" ((USItype)(sl)) \
|
|
||||||
@@ -523,7 +523,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"g" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("sub%.l %5,%1
|
|
||||||
+ __asm__ ("sub%.l %5,%1\n\
|
|
||||||
subx%.l %3,%0" \
|
|
||||||
: "=d" ((USItype)(sh)), \
|
|
||||||
"=&d" ((USItype)(sl)) \
|
|
||||||
@@ -562,27 +562,27 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
#else /* not mc68020 */
|
|
||||||
#define umul_ppmm(xh, xl, a, b) \
|
|
||||||
do { USItype __umul_tmp1, __umul_tmp2; \
|
|
||||||
- __asm__ ("| Inlined umul_ppmm
|
|
||||||
- move%.l %5,%3
|
|
||||||
- move%.l %2,%0
|
|
||||||
- move%.w %3,%1
|
|
||||||
- swap %3
|
|
||||||
- swap %0
|
|
||||||
- mulu %2,%1
|
|
||||||
- mulu %3,%0
|
|
||||||
- mulu %2,%3
|
|
||||||
- swap %2
|
|
||||||
- mulu %5,%2
|
|
||||||
- add%.l %3,%2
|
|
||||||
- jcc 1f
|
|
||||||
- add%.l %#0x10000,%0
|
|
||||||
-1: move%.l %2,%3
|
|
||||||
- clr%.w %2
|
|
||||||
- swap %2
|
|
||||||
- swap %3
|
|
||||||
- clr%.w %3
|
|
||||||
- add%.l %3,%1
|
|
||||||
- addx%.l %2,%0
|
|
||||||
+ __asm__ ("| Inlined umul_ppmm\n\
|
|
||||||
+ move%.l %5,%3\n\
|
|
||||||
+ move%.l %2,%0\n\
|
|
||||||
+ move%.w %3,%1\n\
|
|
||||||
+ swap %3\n\
|
|
||||||
+ swap %0\n\
|
|
||||||
+ mulu %2,%1\n\
|
|
||||||
+ mulu %3,%0\n\
|
|
||||||
+ mulu %2,%3\n\
|
|
||||||
+ swap %2\n\
|
|
||||||
+ mulu %5,%2\n\
|
|
||||||
+ add%.l %3,%2\n\
|
|
||||||
+ jcc 1f\n\
|
|
||||||
+ add%.l %#0x10000,%0\n\
|
|
||||||
+1: move%.l %2,%3\n\
|
|
||||||
+ clr%.w %2\n\
|
|
||||||
+ swap %2\n\
|
|
||||||
+ swap %3\n\
|
|
||||||
+ clr%.w %3\n\
|
|
||||||
+ add%.l %3,%1\n\
|
|
||||||
+ addx%.l %2,%0\n\
|
|
||||||
| End inlined umul_ppmm" \
|
|
||||||
: "=&d" ((USItype)(xh)), "=&d" ((USItype)(xl)), \
|
|
||||||
"=d" (__umul_tmp1), "=&d" (__umul_tmp2) \
|
|
||||||
@@ -595,7 +595,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__m88000__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("addu.co %1,%r4,%r5
|
|
||||||
+ __asm__ ("addu.co %1,%r4,%r5\n\
|
|
||||||
addu.ci %0,%r2,%r3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -604,7 +604,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%rJ" ((USItype)(al)), \
|
|
||||||
"rJ" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subu.co %1,%r4,%r5
|
|
||||||
+ __asm__ ("subu.co %1,%r4,%r5\n\
|
|
||||||
subu.ci %0,%r2,%r3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -663,8 +663,8 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"d" ((USItype)(v)))
|
|
||||||
#else
|
|
||||||
#define umul_ppmm(w1, w0, u, v) \
|
|
||||||
- __asm__ ("multu %2,%3
|
|
||||||
- mflo %0
|
|
||||||
+ __asm__ ("multu %2,%3\n\
|
|
||||||
+ mflo %0\n\
|
|
||||||
mfhi %1" \
|
|
||||||
: "=d" ((USItype)(w0)), \
|
|
||||||
"=d" ((USItype)(w1)) \
|
|
||||||
@@ -685,8 +685,8 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"d" ((UDItype)(v)))
|
|
||||||
#else
|
|
||||||
#define umul_ppmm(w1, w0, u, v) \
|
|
||||||
- __asm__ ("dmultu %2,%3
|
|
||||||
- mflo %0
|
|
||||||
+ __asm__ ("dmultu %2,%3\n\
|
|
||||||
+ mflo %0\n\
|
|
||||||
mfhi %1" \
|
|
||||||
: "=d" ((UDItype)(w0)), \
|
|
||||||
"=d" ((UDItype)(w1)) \
|
|
||||||
@@ -855,7 +855,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__pyr__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("addw %5,%1
|
|
||||||
+ __asm__ ("addw %5,%1\n\
|
|
||||||
addwc %3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -864,7 +864,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"g" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subw %5,%1
|
|
||||||
+ __asm__ ("subw %5,%1\n\
|
|
||||||
subwb %3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -877,7 +877,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
({union {UDItype __ll; \
|
|
||||||
struct {USItype __h, __l;} __i; \
|
|
||||||
} __xx; \
|
|
||||||
- __asm__ ("movw %1,%R0
|
|
||||||
+ __asm__ ("movw %1,%R0\n\
|
|
||||||
uemul %2,%0" \
|
|
||||||
: "=&r" (__xx.__ll) \
|
|
||||||
: "g" ((USItype) (u)), \
|
|
||||||
@@ -887,7 +887,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__ibm032__) /* RT/ROMP */ && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("a %1,%5
|
|
||||||
+ __asm__ ("a %1,%5\n\
|
|
||||||
ae %0,%3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -896,7 +896,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"r" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("s %1,%5
|
|
||||||
+ __asm__ ("s %1,%5\n\
|
|
||||||
se %0,%3" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -908,25 +908,25 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
do { \
|
|
||||||
USItype __m0 = (m0), __m1 = (m1); \
|
|
||||||
__asm__ ( \
|
|
||||||
- "s r2,r2
|
|
||||||
- mts r10,%2
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- m r2,%3
|
|
||||||
- cas %0,r2,r0
|
|
||||||
+ "s r2,r2\n\
|
|
||||||
+ mts r10,%2\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ m r2,%3\n\
|
|
||||||
+ cas %0,r2,r0\n\
|
|
||||||
mfs r10,%1" \
|
|
||||||
: "=r" ((USItype)(ph)), \
|
|
||||||
"=r" ((USItype)(pl)) \
|
|
||||||
@@ -957,8 +957,8 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
#if defined (__sh2__) && W_TYPE_SIZE == 32
|
|
||||||
#define umul_ppmm(w1, w0, u, v) \
|
|
||||||
__asm__ ( \
|
|
||||||
- "dmulu.l %2,%3
|
|
||||||
- sts macl,%1
|
|
||||||
+ "dmulu.l %2,%3\n\
|
|
||||||
+ sts macl,%1\n\
|
|
||||||
sts mach,%0" \
|
|
||||||
: "=r" ((USItype)(w1)), \
|
|
||||||
"=r" ((USItype)(w0)) \
|
|
||||||
@@ -970,7 +970,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__sparc__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("addcc %r4,%5,%1
|
|
||||||
+ __asm__ ("addcc %r4,%5,%1\n\
|
|
||||||
addx %r2,%3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -980,7 +980,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"rI" ((USItype)(bl)) \
|
|
||||||
__CLOBBER_CC)
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subcc %r4,%5,%1
|
|
||||||
+ __asm__ ("subcc %r4,%5,%1\n\
|
|
||||||
subx %r2,%3,%0" \
|
|
||||||
: "=r" ((USItype)(sh)), \
|
|
||||||
"=&r" ((USItype)(sl)) \
|
|
||||||
@@ -1027,44 +1027,44 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"r" ((USItype)(v)))
|
|
||||||
#define UMUL_TIME 5
|
|
||||||
#define udiv_qrnnd(q, r, n1, n0, d) \
|
|
||||||
- __asm__ ("! Inlined udiv_qrnnd
|
|
||||||
- wr %%g0,%2,%%y ! Not a delayed write for sparclite
|
|
||||||
- tst %%g0
|
|
||||||
- divscc %3,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%%g1
|
|
||||||
- divscc %%g1,%4,%0
|
|
||||||
- rd %%y,%1
|
|
||||||
- bl,a 1f
|
|
||||||
- add %1,%4,%1
|
|
||||||
+ __asm__ ("! Inlined udiv_qrnnd\n\
|
|
||||||
+ wr %%g0,%2,%%y ! Not a delayed write for sparclite\n\
|
|
||||||
+ tst %%g0\n\
|
|
||||||
+ divscc %3,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%%g1\n\
|
|
||||||
+ divscc %%g1,%4,%0\n\
|
|
||||||
+ rd %%y,%1\n\
|
|
||||||
+ bl,a 1f\n\
|
|
||||||
+ add %1,%4,%1\n\
|
|
||||||
1: ! End of inline udiv_qrnnd" \
|
|
||||||
: "=r" ((USItype)(q)), \
|
|
||||||
"=r" ((USItype)(r)) \
|
|
||||||
@@ -1085,45 +1085,45 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
/* Default to sparc v7 versions of umul_ppmm and udiv_qrnnd. */
|
|
||||||
#ifndef umul_ppmm
|
|
||||||
#define umul_ppmm(w1, w0, u, v) \
|
|
||||||
- __asm__ ("! Inlined umul_ppmm
|
|
||||||
- wr %%g0,%2,%%y ! SPARC has 0-3 delay insn after a wr
|
|
||||||
- sra %3,31,%%g2 ! Don't move this insn
|
|
||||||
- and %2,%%g2,%%g2 ! Don't move this insn
|
|
||||||
- andcc %%g0,0,%%g1 ! Don't move this insn
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,%3,%%g1
|
|
||||||
- mulscc %%g1,0,%%g1
|
|
||||||
- add %%g1,%%g2,%0
|
|
||||||
+ __asm__ ("! Inlined umul_ppmm\n\
|
|
||||||
+ wr %%g0,%2,%%y ! SPARC has 0-3 delay insn after a wr\n\
|
|
||||||
+ sra %3,31,%%g2 ! Don't move this insn\n\
|
|
||||||
+ and %2,%%g2,%%g2 ! Don't move this insn\n\
|
|
||||||
+ andcc %%g0,0,%%g1 ! Don't move this insn\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,%3,%%g1\n\
|
|
||||||
+ mulscc %%g1,0,%%g1\n\
|
|
||||||
+ add %%g1,%%g2,%0\n\
|
|
||||||
rd %%y,%1" \
|
|
||||||
: "=r" ((USItype)(w1)), \
|
|
||||||
"=r" ((USItype)(w0)) \
|
|
||||||
@@ -1147,7 +1147,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
|
|
||||||
#if defined (__vax__) && W_TYPE_SIZE == 32
|
|
||||||
#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("addl2 %5,%1
|
|
||||||
+ __asm__ ("addl2 %5,%1\n\
|
|
||||||
adwc %3,%0" \
|
|
||||||
: "=g" ((USItype)(sh)), \
|
|
||||||
"=&g" ((USItype)(sl)) \
|
|
||||||
@@ -1156,7 +1156,7 @@ extern USItype __udiv_qrnnd ();
|
|
||||||
"%1" ((USItype)(al)), \
|
|
||||||
"g" ((USItype)(bl)))
|
|
||||||
#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
|
|
||||||
- __asm__ ("subl2 %5,%1
|
|
||||||
+ __asm__ ("subl2 %5,%1\n\
|
|
||||||
sbwc %3,%0" \
|
|
||||||
: "=g" ((USItype)(sh)), \
|
|
||||||
"=&g" ((USItype)(sl)) \
|
|
||||||
diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs
|
|
||||||
--- a/ghc/lib/std/CPUTime.lhs
|
|
||||||
+++ b/ghc/lib/std/CPUTime.lhs
|
|
||||||
@@ -9,6 +9,6 @@
|
|
||||||
module CPUTime
|
|
||||||
(
|
|
||||||
getCPUTime, -- :: IO Integer
|
|
||||||
- cpuTimePrecision -- :: Integer
|
|
||||||
+ cpuTimePrecision -- :: Integer
|
|
||||||
) where
|
|
||||||
\end{code}
|
|
||||||
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue