From: Ricardo Wurmus <rekado@elephly.net>
To: 53609@debbugs.gnu.org
Cc: Ricardo Wurmus <rekado@elephly.net>
Subject: [bug#53609] [PATCH v2 4/4] gnu: Add ghc-4.
Date: Sat, 5 Feb 2022 01:08:23 +0100 [thread overview]
Message-ID: <20220205000823.2680-4-rekado@elephly.net> (raw)
In-Reply-To: <20220205000823.2680-1-rekado@elephly.net>
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain; charset=UTF-8, Size: 32666 bytes --]
* 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
prev parent reply other threads:[~2022-02-05 0:10 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-01-28 17:35 [bug#53609] [PATCH] Add GHC 4 for the Haskell bootstrap Ricardo Wurmus
2022-01-28 17:48 ` [bug#53609] [PATCH 1/2] gnu: Add perl-5.14 Ricardo Wurmus
2022-01-28 17:48 ` [bug#53609] [PATCH 2/2] gnu: Add ghc-4 Ricardo Wurmus
2022-01-29 18:56 ` Ricardo Wurmus
2022-02-05 0:08 ` [bug#53609] [PATCH v2 1/4] gnu: Add perl-5.14 Ricardo Wurmus
2022-02-05 0:08 ` [bug#53609] [PATCH v2 2/4] gnu: Add gcc-2.95-wrapper Ricardo Wurmus
2022-02-05 0:08 ` [bug#53609] [PATCH v2 3/4] gnu: Add glibc-2.2.5 Ricardo Wurmus
2022-02-05 14:44 ` Maxime Devos
2022-02-05 0:08 ` Ricardo Wurmus [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220205000823.2680-4-rekado@elephly.net \
--to=rekado@elephly.net \
--cc=53609@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).