diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/packages/haskell.scm | 214 | ||||
| -rw-r--r-- | gnu/packages/patches/ghc-4.patch | 708 |
3 files changed, 922 insertions, 1 deletions
diff --git a/gnu/local.mk b/gnu/local.mk index 6c6543b5a3..09dd9acc2f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1140,6 +1140,7 @@ dist_patch_DATA = \ %D%/packages/patches/geeqie-clutter.patch \ %D%/packages/patches/genimage-mke2fs-test.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-testsuite-dlopen-pie.patch \ %D%/packages/patches/ghc-language-haskell-extract-ghc-8.10.patch \ diff --git a/gnu/packages/haskell.scm b/gnu/packages/haskell.scm index 699b45e45a..020011d955 100644 --- a/gnu/packages/haskell.scm +++ b/gnu/packages/haskell.scm @@ -6,7 +6,7 @@ ;;; Copyright © 2016, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017 Nikita <nikita@n0.is> ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il> -;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2022 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016, 2017 David Craven <david@craven.ch> ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com> @@ -41,10 +41,18 @@ (define-module (gnu packages haskell) #:use-module (gnu packages) + #:use-module (gnu packages autotools) + #:use-module (gnu packages base) + #:use-module (gnu packages bash) + #:use-module (gnu packages bison) #:use-module (gnu packages bootstrap) + #:use-module (gnu packages compression) #:use-module (gnu packages elf) + #:use-module (gnu packages file) + #:use-module (gnu packages gawk) #:use-module (gnu packages ghostscript) #:use-module (gnu packages libffi) + #:use-module (gnu packages linux) #:use-module (gnu packages lisp) #:use-module (gnu packages multiprecision) #:use-module (gnu packages ncurses) @@ -99,6 +107,210 @@ top of CLISP.") (license license:bsd-4)))) +(define-public ghc-4 + (package + (name "ghc") + (version "4.08.2") + (source + (origin + (method url-fetch) + (uri (string-append "https://www.haskell.org/ghc/dist/" + version "/" name "-" version "-src.tar.bz2")) + (sha256 + (base32 + "0ar4nxy4cr5vwvfj71gmc174vx0n3lg9ka05sa1k60c8z0g3xp1q")) + (patches (list (search-patch "ghc-4.patch"))))) + (build-system gnu-build-system) + (supported-systems '("i686-linux" "x86_64-linux")) + (arguments + `(#:system "i686-linux" + #:implicit-inputs? #f + #:strip-binaries? #f + #:phases + (modify-phases %standard-phases + (replace 'bootstrap + (lambda* (#:key inputs #:allow-other-keys) + (delete-file "configure") + (delete-file "config.sub") + (install-file (string-append (assoc-ref inputs "automake") + "/share/automake-1.16/config.sub") + ".") + + ;; Avoid dependency on "happy" + (substitute* "configure.in" + (("FPTOOLS_HAPPY") "echo sure\n")) + + ;; Set options suggested in ghc/interpreter/README.BUILDING.HUGS. + (with-output-to-file "mk/build.mk" + (lambda () + (display " +WithGhcHc=ghc-4.06 +GhcLibWays=u +#HsLibsFor=hugs +# Setting this leads to building the interpreter. +GhcHcOpts=-DDEBUG +GhcRtsHcOpts=-optc-DDEBUG -optc-D__HUGS__ -unreg -optc-g +GhcRtsCcOpts=-optc-DDEBUG -optc-g -optc-D__HUGS__ +SplitObjs=NO +"))) + + (substitute* "ghc/interpreter/interface.c" + ;; interface.c:2702: `stackOverflow' redeclared as different kind of symbol + ;; ../includes/Stg.h:188: previous declaration of `stackOverflow' + ((".*Sym\\(stackOverflow\\).*") "") + ;; interface.c:2713: `stg_error_entry' undeclared here (not in a function) + ;; interface.c:2713: initializer element is not constant + ;; interface.c:2713: (near initialization for `rtsTab[11].ad') + ((".*SymX\\(stg_error_entry\\).*") "") + ;; interface.c:2713: `Upd_frame_info' undeclared here (not in a function) + ;; interface.c:2713: initializer element is not constant + ;; interface.c:2713: (near initialization for `rtsTab[32].ad') + ((".*SymX\\(Upd_frame_info\\).*") "")) + + ;; We need to use the absolute file names here or else the linker + ;; will complain about missing symbols. Perhaps this could be + ;; avoided by modifying the library search path in a way that + ;; this old linker understands. + (substitute* "ghc/interpreter/Makefile" + (("-lbfd -liberty") + (string-append (assoc-ref inputs "binutils") "/lib/libbfd.a " + (assoc-ref inputs "binutils") "/lib/libiberty.a"))) + + (let ((bash (which "bash"))) + (substitute* '("configure.in" + "ghc/configure.in" + "ghc/rts/gmp/mpn/configure.in" + "ghc/rts/gmp/mpz/configure.in" + "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)) + + (setenv "CPP" (string-append (assoc-ref inputs "gcc") "/bin/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"))) + (invoke bash "./configure" + "--enable-hc-boot" + (string-append "--prefix=" out) + (string-append "--build=" build) + (string-append "--host=" build))))) + (add-before 'build 'make-boot + (lambda _ + ;; 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" + (("^# .*") "")) + ;; CLK_TCK has been removed + (substitute* "ghc/interpreter/nHandle.c" + (("CLK_TCK") "sysconf(_SC_CLK_TCK)"))) + + ;; 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 + `(("findutils" ,findutils) + ("tar" ,tar) + ("bzip2" ,bzip2) + ("xz" ,xz) + ("diffutils" ,diffutils) + ("file" ,file) + ("gawk" ,gawk) + ("autoconf" ,autoconf-2.13) + ("automake" ,automake) + ("bison" ,bison) ;for parser.y + + ("make" ,gnu-make) + ("sed" ,sed) + ("grep" ,grep) + ("coreutils" ,coreutils) + ("bash" ,bash-minimal) + + ("libc" ,glibc-2.2.5) + ;; Lazily resolve binutils-mesboot in (gnu packages commencement) to + ;; avoid a cycle. + ("gcc-wrapper" + ,(module-ref (resolve-interface + '(gnu packages commencement)) + 'gcc-2.95-wrapper)) + ("gcc" + ,(module-ref (resolve-interface + '(gnu packages commencement)) + 'gcc-mesboot0)) + ("binutils" + ,(module-ref (resolve-interface + '(gnu packages commencement)) + 'binutils-mesboot)) + ("kernel-headers" ,linux-libre-headers) + + ;; TODO: 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" ,perl-5.14))) + (home-page "https://www.haskell.org/ghc") + (synopsis "The Glasgow Haskell Compiler") + (description + "The Glasgow Haskell Compiler (GHC) is a state-of-the-art compiler and +interactive environment for the functional language Haskell. The value of +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))) + (define ghc-bootstrap-x86_64-7.8.4 (origin (method url-fetch) diff --git a/gnu/packages/patches/ghc-4.patch b/gnu/packages/patches/ghc-4.patch new file mode 100644 index 0000000000..87484f575d --- /dev/null +++ b/gnu/packages/patches/ghc-4.patch @@ -0,0 +1,708 @@ +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} + \ No newline at end of file |