gnu: Add ghc-4.

* gnu/packages/patches/ghc-4.patch: New file
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/haskell.scm (ghc-4): New variable.
This commit is contained in:
Ricardo Wurmus 2022-01-28 18:34:32 +01:00
parent a95924c9ac
commit 3817ea91b7
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
3 changed files with 922 additions and 1 deletions

View file

@ -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 \

View file

@ -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 @@ (define-public cl-yale-haskell
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)

View file

@ -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}