Subject: [bug#53609] [PATCH v2 4/4] gnu: Add ghc-4.

From: Ricardo Wurmus <[email-masked]>
Date: Sat, 5 Feb 2022 01:08:23 +0100

* gnu/packages/patches/ghc-4.patch: New file
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/commencement.scm (ghc-4): New variable.
---
 gnu/local.mk                     |   1 +
 gnu/packages/commencement.scm    | 188 ++++++++
 gnu/packages/patches/ghc-4.patch | 708 +++++++++++++++++++++++++++++++
 3 files changed, 897 insertions(+)
 create mode 100644 gnu/packages/patches/ghc-4.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index b906d234fc..674ea4052a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1135,6 +1135,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/commencement.scm b/gnu/packages/commencement.scm
index 4f10b22e78..94534ee55a 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -30,6 +30,7 @@
 
 (define-module (gnu packages commencement)
   #:use-module (gnu packages)
+  #:use-module (gnu packages autotools)
   #:use-module (gnu packages bootstrap)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
@@ -3992,5 +3993,192 @@ (define-public gfortran-toolchain
 gfortran, as well as libc (headers and binaries, plus debugging symbols
 in the @code{debug} output), and binutils.")))
 
+(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 _
+             (invoke "make" "all")))
+         (add-after 'build 'build-hugs
+           (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" "-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-final)
+       ("sed" ,sed-final)
+       ("grep" ,grep-final)
+       ("coreutils" ,coreutils-final)
+       ("bash" ,bash-final)
+
+       ("gcc-wrapper" ,gcc-2.95-wrapper)
+       ("gcc" ,gcc-mesboot0)
+       ("libc" ,glibc-2.2.5)
+       ("binutils" ,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.")
+    (license license:bsd-3)))
 
 ;;; commencement.scm ends here
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
-- 
2.34.0