[GHC] #10383: AArch64: get GHC Calling convention working

#10383: AArch64: get GHC Calling convention working -------------------------------------+------------------------------------- Reporter: erikd | Owner: erikd Type: feature | Status: new request | Milestone: 7.12.1 Priority: normal | Version: 7.11 Component: Compiler | Operating System: Unknown/Multiple Keywords: | Type of failure: Building GHC Architecture: aarch64 | failed Test Case: | Blocked By: Blocking: | Related Tickets: Differential Revisions: | -------------------------------------+------------------------------------- Building on AArch64 via the LLVM abckend has been working for some time. Its now time to get `("Unregisterised", "NO")` working as well. Enabling GHC calling convention can be done with this patch to `configure.ac`: {{{ diff --git a/configure.ac b/configure.ac index d5d9ab3..a11e5af 100644 --- a/configure.ac +++ b/configure.ac @@ -241,7 +241,7 @@ AC_SUBST(SOLARIS_BROKEN_SHLD) dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- case "$HostArch" in - i386|x86_64|powerpc|arm) + i386|x86_64|powerpc|arm|aarch64) UnregisterisedDefault=NO ;; *) }}} but when building it this way, the stage2 compiler dies will `Illegal instructon`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working
----------------------------------------+----------------------------------
Reporter: erikd | Owner: erikd
Type: feature request | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: aarch64
Type of failure: Building GHC failed | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Revisions:
----------------------------------------+----------------------------------
Comment (by erikd):
I loaded the failing ghc-stage2 command into gdb, set a breakpoint on the
`main` function and then single stepped through the assembler. These are
the instructions executed:
{{{
0x41b5d8

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by rwbarton): Well `MainCapability` is a Capability, not a function, so its contents look fine. Of course then there is the question of why we are trying to execute it. In general that assembly trace looks strange, it seems to jump around a few times for no apparent reason. Try adding `+RTS -V0 -RTS` to the failing command line to disable the tick timer, that usually helps when a GHC-built program is acting oddly under gdb, though I don't actually understand this particular weirdness. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): By adding `-debug` to `GhcStage2HcOpts` of `mk/build.mk` I turned up a different issue that I'm pretty sure is related, `inplace/bin/dll-split` exits with: {{{ dll-split: internal error: invalid closure, info=(nil) (GHC version 7.11.20150514 for aarch64_unknown_linux) }}} trigger by the assert: {{{ ASSERTM(LOOKS_LIKE_CLOSURE_PTR(q), "invalid closure, info=%p", q->header.info); }}} Adding a bit of `printf` debugging showed that the above assert passed a couple of hundred times before it found a NULL in `q->header.info`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): The `ASSERTM` in the previous comment is in the file `rts/sm/Evac.c` in a funciton called `evacuate`. Adding a little more debugging and found that this `evacuate` function is called over 19000 times before the assertion is triggered. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by rwbarton): That means the beginning of a closure (heap object) got overwritten with zeros somehow and it was discovered during garbage collection. Have you tried running with `-DS`? That might find the offender earlier. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): Yes, tied `+RTS -DS -RTS` and the only extra debug output I get is: {{{ cap 0: initialised }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): I am reasonably certain that this is the same problem as #10375. Running: {{{ inplace/bin/ghc-stage2 +RTS -Ds -Di -Dw -DG -Dg -Db -DS -Dt -Dp -Da -Dl -Dm \ -Dc -Dr }}} otherwise know as "all the damn debug flags I can find" results in: {{{ stg_ap_v_ret... FUN/1(0x7f99ceba88, 0x7f98f041b9, 0x7f98f05448, 0x7f98f084c8, 0x7f98f084d8, 0x7f993cb861, 0x7f98f08558, (nil)d#, (nil)d#, 0x1fd#, 0x4d#, 0x5d#, 0x6d#) stg_ap_0_ret... base:GHC.Event.Manager.Created() 7f98eff1f0: cap 0: thread 2 stopped (yielding) 7f98eff1f0: giving up capability 0 7f98eff1f0: passing capability 0 to bound task 0x7f990ff000 7f990ff000: woken up on capability 0 7f990ff000: resuming capability 0 7f990ff000: cap 0: running thread 1 (ThreadRunGHC) Segmentation fault }}} which just like trac #10375 is GHC crashing in the `schedule` function of `rts/Schedule.c` with `what_next == ThreadRunGHC`. Will keep this open just in case its not. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): Narrowed the problem down to code in `rts/sm/Evac.c` namely: {{{ do { info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info); } while (info_ptr == (W_)&stg_WHITEHOLE_info); }}} Adding a `printf` before and after the call to `xchg` found that the exchange was happening, but the function was returning `0` instead of the old value of `p->header.info`. Wrote a small program to test this: {{{ #include "PosixSource.h" #include "Rts.h" #include "Stg.h" #include "stg/Types.h" #include "stg/SMP.h" int main (void) { StgWord a = 0xa, b = 0xb, res = 1; printf ("0x%lx 0x%lx 0x%lx\n", res, a, b); res = xchg(&a, b); printf ("0x%lx 0x%lx 0x%lx\n", res, a, b); return 0; } }}} which I compile and run as: {{{ gcc-5 -Wall -O3 -Iincludes -Irts -fno-stack-protector -DTHREADED_RTS \ -DCOMPILING_RTS xchg_test.c -o xchg_test && ./xchg_test }}} which on AArch64/Arm64 results: {{{ 0x1 0xa 0xb 0x0 0xb 0xb }}} which is just profoundly wrong! The expected result is: {{{ 0x1 0xa 0xb 0xa 0xb 0xb }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): The `xchg` issue above was fixed in git commit f6ca6959e54ede0b28735ab7e011c16b3cb172db. Running `inplace/bin/ghc-stage2 +RTS -Da` under GDB now results in: {{{ ..... stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) [New Thread 0x7fb39ff1f0 (LWP 25080)] stg_ap_v_ret... FUN/1(0x7fb47b8c78, 0x7fb3a041b9, 0x7fb3a05448, 0x7fb3a084c8 , 0x7fb3a084d8, 0x7fb3e96861, 0x7fb3a08558, (nil)d#, (nil)d#, 0x1fd#, 0x4d# , 0x5d#, 0x6d#) stg_ap_0_ret... base:GHC.Event.Manager.Created() Program received signal SIGSEGV, Segmentation fault. 0x0000007fb3dac244 in stg_ap_p_fast$def () from /home/erikd/ghc- upstream/rts/ dist/build/libHSrts_thr_debug-ghc7.11.20150602.so (gdb) bt #0 0x0000007fb3dac244 in stg_ap_p_fast$def () from /home/erikd/ghc- upstream/ rts/dist/build/libHSrts_thr_debug-ghc7.11.20150602.so Backtrace stopped: previous frame identical to this frame (corrupt stack?) }}} By hacking on `utils/genapply/GenApply.hs` I was able to add some more debug to the generated file `rts/dist/build/AutoApply.cmm` so that the generaed code for `stg_ap_pv_fast` looks like: {{{ stg_ap_pv_fast { W_ info; W_ arity; W_ xxxx; if (GETTAG(R1)==2) { Sp_adj(0); jump %GET_ENTRY(R1-2) [R1,R2]; } #ifdef PROFILING if (Sp - WDS(3) < SpLim) { Sp_adj(-2); W_[Sp+WDS(1)] = R2; Sp(0) = stg_ap_pv_info; jump __stg_gc_enter_1 [R1]; } #else if (Sp - WDS(2) < SpLim) { Sp_adj(-2); W_[Sp+WDS(1)] = R2; Sp(0) = stg_ap_pv_info; jump __stg_gc_enter_1 [R1]; } #endif R1 = UNTAG(R1); info = %GET_STD_INFO(R1); IF_DEBUG(apply,foreign "C" debugBelch("genApplyFast before\n");); xxxx = TO_W_(%INFO_TYPE(info)); IF_DEBUG(apply,foreign "C" debugBelch("genApplyFast after\n");); switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (xxxx) { .... }}} With thjis debug the backtrace in GDB now looks like: {{{ stg_ap_0_ret... FUN/4(0x7fb46fcc28) stg_ap_pppv_ret... FUN/4(0x7fb46fcc28) [New Thread 0x7fb39ff1f0 (LWP 25080)] stg_ap_v_ret... FUN/1(0x7fb47b8c78, 0x7fb3a041b9, 0x7fb3a05448, 0x7fb3a084c8 , 0x7fb3a084d8, 0x7fb3e96861, 0x7fb3a08558, (nil)d#, (nil)d#, 0x1fd#, 0x4d# , 0x5d#, 0x6d#) stg_ap_0_ret... base:GHC.Event.Manager.Created() genApplyFast before genApplyFast after genApplyFast before Program received signal SIGSEGV, Segmentation fault. 0x0000007fb3dac244 in stg_ap_p_fast$def () from /home/erikd/ghc- upstream/rts/ dist/build/libHSrts_thr_debug-ghc7.11.20150602.so }}} suggesting it is segfaulting on the line: {{{ xxxx = TO_W_(%INFO_TYPE(info)); }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:8 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working
----------------------------------------+----------------------------------
Reporter: erikd | Owner: erikd
Type: feature request | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: aarch64
Type of failure: Building GHC failed | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Revisions:
----------------------------------------+----------------------------------
Comment (by erikd):
With the help of @rwbarton got the disassembly around the crash site:
{{{
(gdb) disass 0x0000007fb3dac244
Dump of assembler code for function stg_ap_p_fast$def:
0x0000007fb3dac1d8 <+0>: mov x24, x20
0x0000007fb3dac1dc <+4>: and x8, x22, #0x7
0x0000007fb3dac1e0 <+8>: cmp x8, #0x1
0x0000007fb3dac1e4 <+12>: b.ne 0x7fb3dac1f8

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 7.12.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): At @rwbarton's suggestion, compiled this program {{{ main = print $ foldl (+) 0 [1..10000000] }}} with `ghc-stage1 -O0` (to thrash the GC) and the resulting program ran correctly. The problem does not seem to be GC related. Can also compile this program with {{{ inplace/bin/ghc-stage1 -O0 -dynamic hello.hs -o hello }}} and that too runs fine so this is unlikely to be dynamic library loading. Running `inplace/bin/ghc-stage2 +RTS -Ds` results in: {{{ 7fb3bc9000: created capset 0 of type 2 7fb3bc9000: created capset 1 of type 3 7fb3bc9000: cap 0: initialised 7fb3bc9000: assigned cap 0 to capset 0 7fb3bc9000: assigned cap 0 to capset 1 7fb3bc9000: allocated 1 more capabilities 7fb3bc9000: new task (taskCount: 1) 7fb3bc9000: returning; I want capability 0 7fb3bc9000: resuming capability 0 7fb3bc9000: cap 0: created thread 1 7fb3bc9000: new bound thread (1) 7fb3bc9000: cap 0: schedule() 7fb3bc9000: cap 0: running thread 1 (ThreadRunGHC) 7fb3bc9000: cap 0: created thread 2 7fb3bc9000: cap 0: thread 1 stopped (yielding) 7fb3bc9000: giving up capability 0 7fb3bc9000: starting new worker on capability 0 7fb3bc9000: new worker task (taskCount: 2) 7fb39ff1f0: cap 0: schedule() 7fb39ff1f0: cap 0: running thread 2 (ThreadRunGHC) 7fb39ff1f0: cap 0: thread 2 stopped (yielding) 7fb39ff1f0: giving up capability 0 7fb39ff1f0: passing capability 0 to bound task 0x7fb3bc9000 7fb3bc9000: woken up on capability 0 7fb3bc9000: resuming capability 0 7fb3bc9000: cap 0: running thread 1 (ThreadRunGHC) Segmentation fault (core dumped) }}} so the crash happens right after it switches threads. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:10 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working
----------------------------------------+----------------------------------
Reporter: erikd | Owner: erikd
Type: feature request | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: aarch64
Type of failure: Building GHC failed | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Revisions:
----------------------------------------+----------------------------------
Comment (by erikd):
Had a further (at least 3rd or 4th) look at the Aarch64 version of the
`StgRun` function in `rts/StgCRun.c`. I noticed that some some of the
registers that are pushed and popped on/off the stack were not listed in
the "clobbered registers" part of the `__asm__` definition.
Came up with this patch:
{{{
commit 5f75cbcea67cbb587a7d640f6241469744ab026f
Author: Erik de Castro Lopo

#10383: AArch64: get GHC Calling convention working
----------------------------------------+----------------------------------
Reporter: erikd | Owner: erikd
Type: feature request | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: aarch64
Type of failure: Building GHC failed | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Revisions:
----------------------------------------+----------------------------------
Comment (by erikd):
With the above patch to `StgRun`, the new backtrace in GDB looks like:
{{{
ghc-stage2: internal error: invalid closure, info=(nil)
(GHC version 7.11.20150602 for aarch64_unknown_linux)
Please report this as a GHC bug:
http://www.haskell.org/ghc/reportabug
Program received signal SIGABRT, Aborted.
0x0000007fb3c009b8 in __GI_raise (sig=sig@entry=6) at
../nptl/sysdeps/unix/sysv/
linux/raise.c:56
56 ../nptl/sysdeps/unix/sysv/linux/raise.c: No such file or
directory.
(gdb) bt
#0 0x0000007fb3c009b8 in __GI_raise (sig=sig@entry=6) at
../nptl/sysdeps/unix/
sysv/linux/raise.c:56
#1 0x0000007fb3c01cc0 in __GI_abort () at abort.c:89
#2 0x0000007fb3d74628 in rtsFatalInternalErrorFn (s=0x7fb3dbb820 "invalid
closure, info=%p", ap=...) at rts/RtsMessages.c:170
#3 0x0000007fb3d74140 in barf (s=0x7fb3dbb820 "invalid closure, info=%p")
at
rts/RtsMessages.c:42
#4 0x0000007fb3d92740 in evacuate1 (p=0x7fb3aad560) at rts/sm/Evac.c:384
#5 0x0000007fb3d8392c in scavenge_block1 (bd=0x7fb3a02b40) at
rts/sm/Scav.c:464
#6 0x0000007fb3d85df4 in scavenge_find_work () at rts/sm/Scav.c:2009
#7 0x0000007fb3d85f98 in scavenge_loop1 () at rts/sm/Scav.c:2085
#8 0x0000007fb3d8d980 in scavenge_until_all_done () at rts/sm/GC.c:977
#9 0x0000007fb3d8c334 in GarbageCollect (collect_gen=0,
do_heap_census=rtsFalse,
gc_type=2, cap=0x7fb3dc4980 <MainCapability>) at rts/sm/GC.c:396
#10 0x0000007fb3d608bc in scheduleDoGC (pcap=0x7fffffec88, task=0x5151c0,
force_major=rtsFalse) at rts/Schedule.c:1674
#11 0x0000007fb3d5ed8c in schedule (initialCapability=0x7fb3dc4980
<MainCapability>, task=0x5151c0) at rts/Schedule.c:557
#12 0x0000007fb3d61ab4 in scheduleWaitThread (tso=0x7fb3a0b388, ret=0x0,
pcap=0x7fffffee00) at rts/Schedule.c:2383
#13 0x0000007fb3d6349c in rts_evalLazyIO (cap=0x7fffffee00, p=0x4c36a0

#10383: AArch64: get GHC Calling convention working
----------------------------------------+----------------------------------
Reporter: erikd | Owner: erikd
Type: feature request | Status: new
Priority: normal | Milestone: 7.12.1
Component: Compiler | Version: 7.11
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture: aarch64
Type of failure: Building GHC failed | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Revisions:
----------------------------------------+----------------------------------
Comment (by erikd):
If I load this up in GDB and break at line 383 of file `rts/sm/Evac.c`
when `q->header.info == 0x0` I see:
{{{
(gdb) print q->header
$8 = {info = 0x0}
(gdb) print &(q->header.info)
$9 = (const StgInfoTable **) 0x7fb3dc4618

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): With the un-reasonable effectiveness of wolf-fence debugging on #10375 I decided to apply it to this one as well and quickly found that the stage2 compiler was crashing in the function `SysTools.initSysTools`. With my added debug that function currently looks like: {{{ initSysTools :: Maybe String -- Maybe TopDir path (without the '-B' prefix) -> IO Settings -- Set all the mutable variables above, holding -- (a) the system programs -- (b) the package-config file -- (c) the GHC usage message initSysTools mbMinusB = do top_dir <- findTopDir mbMinusB -- see [Note topdir] -- NB: top_dir is assumed to be in standard Unix -- format, '/' separated let settingsFile = top_dir > "settings" platformConstantsFile = top_dir > "platformConstants" installed :: FilePath -> FilePath installed file = top_dir > file putStrLn "initSysTools: About to read settingsFile" settingsStr <- readFile settingsFile putStrLn $ "initSysTools: settingsStr = \n" ++ settingsStr ++ "\n" mySettings <- case maybeReadFuzzy settingsStr of Just s -> do putStrLn "initSysTools: mySettings is Just" return s Nothing -> do putStrLn $ "initSysTools mySettings is Nothing" pgmError ("Can't parse " ++ show settingsFile) putStrLn $ "initSysTools " ++ show (__LINE__ :: Int) ... }}} and it crashes with: {{{ initSysTools: About to read settingsFile initSysTools: settingsStr = [("GCC extra via C opts", " -fwrapv"), ("C compiler command", "/usr/bin/gcc"), ("C compiler flags", " -fno-stack-protector"), ("C compiler link flags", " -fuse-ld=gold -Wl,-z,noexecstack"), ("Haskell CPP command","/usr/bin/gcc"), ("Haskell CPP flags","-E -undef -traditional"), ("ld command", "/usr/bin/ld.gold"), ("ld flags", " -z noexecstack"), ("ld supports compact unwind", "YES"), ("ld supports build-id", "YES"), ("ld supports filelist", "NO"), ("ld is GNU ld", "YES"), ("ar command", "/usr/bin/ar"), ("ar flags", "q"), ("ar supports at file", "YES"), ("touch command", "touch"), ("dllwrap command", "/bin/false"), ("windres command", "/bin/false"), ("libtool command", "libtool"), ("perl command", "/usr/bin/perl"), ("cross compiling", "NO"), ("target os", "OSLinux"), ("target arch", "ArchARM64"), ("target word size", "8"), ("target has GNU nonexec stack", "True"), ("target has .ident directive", "True"), ("target has subsections via symbols", "False"), ("Unregisterised", "NO"), ("LLVM llc command", "/usr/bin/llc-3.6"), ("LLVM opt command", "/usr/bin/opt-3.6") ] ghc-stage2: internal error: invalid closure, info=(nil) (GHC version 7.11.20150916 for aarch64_unknown_linux) Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug }}} It reads the `String` from `settingsFile` and prints it and then crashes in the pure function `maybeReadFuzzy`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by edmund): A couple of questions: Does the build always fail at the same point? What happens if you restrict everything to a single CPU (taskset 0x02 command...)? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:16 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+---------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: ----------------------------------------+---------------------------------- Comment (by erikd): Yes, the build always fails the first time it tries to use the `ghc- stage2` binary. In fact that binary will also fail the same way when building the most trivial "hello world" program. It fails in exactly the same way when run as `taskset 0x02 inplace/bin /ghc-stage2 hello.hs -o hello`. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:17 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by edmund): So the stage1 compiler builds a stage2 compiler which fails when building anything at all. But the stage1 compiler builds a hello.hs that works (comment 10, above). Would it be possible to run the testsuite on the stage1 compiler, with various optimisation options, to get an idea of what the stage1 compiler can and cannot do? That might lead to a simpler test case than GHC itself, or there might be some interesting pattern in the failures. Just a suggestion. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:18 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by rwbarton): You can certainly try to run the test suite against the stage1 compiler, see Building/RunningTests/Running. {{{ make TEST_HC=/path/to/ghc/inplace/bin/ghc-stage1 }}} I don't think we mark tests for whether they are expected to work under the stage1 compiler, so there will be a lot of false negatives (anything involving ghci or TH). But you could compare the failures to those on x86_64 and hopefully there will be some new, small tests that fail. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:19 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by edmund): Alternatively, would the following procedure work? - Build the unmodified source in the usual way, all stages. - Run the testsuite to give a basis for comparison. - Set stage=2 in build.mk. - Reconfigure: ./configure --disable-unregisterised - make - Run the testsuite again. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:20 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by edmund): By the way, what BuildFlavour are you using? https://ghc.haskell.org/trac/ghc/wiki/ImprovedLLVMBackend says: "GHC HEAD now requires LLVM 3.6.x" https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=796343 says: "arm64 has some (many) problems with older llvm such as the currently Debian default one. I tried to reproduce this (really nice) bug report, and I succeeded with llvm-3.4, 3.5 and 3.6." What's the best way of building GHC without LLVM? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:21 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by erikd): GHC builds fine on arm64 in un-registerised mode. I haven't built any packages, but it should just work. The problem in this ticket is only about registerised mode (See https://ghc.haskell.org/trac/ghc/wiki/Building/Unregisterised). The only (main?) problem with un-registerised mode is that the compiler and its executables are far slower than I have what seem to be working ghc-7.8.4 and ghc-7.10.2 compilers (un- registerised) on Debian. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:22 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by edmund): Have you had any LLVM errors, such as the segfault in 'Greedy Register Allocator'? If you haven't, it might be because you're using the "native code generator" rather than the "LLVM code generator". That might be because of your BuildFlavour. Which BuildFlavour are you using? How are you building GHC, exactly? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:23 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by erikd): Oh wow, that is embarrassing! Rechecked the `mk/build.mk` file and found that `BuildFlavour` was not set. Not sure what the hell it was building. Anyway, setting `BuildFlavour=quick-llvm` I then get: {{{ "inplace/bin/ghc-stage1" -static -O0 -H64m -fllvm -Iincludes -Iincludes/dist -Iincludes/dist-derivedconstants/header -Iincludes/dist- ghcconstants/header -Irts -Irts/dist/build -DCOMPILING_RTS -this-package-key rts -dcmm-lint -i -irts -irts/dist/build -irts/dist/build/autogen -Irts/dist/build -Irts/dist/build/autogen -O2 -c rts/PrimOps.cmm -o rts/dist/build/PrimOps.o 0 libLLVM-3.6.so.1 0x0000007f787be130 llvm::sys::PrintStackTrace(_IO_FILE*) + 48 Stack dump: 0. Program arguments: /usr/bin/llc-3.6 -O3 -relocation-model=static /tmp/ghc17942_0/ghc_5.bc -o /tmp/ghc17942_0/ghc_6.lm_s --enable- tbaa=true 1. Running pass 'Function Pass Manager' on module '/tmp/ghc17942_0/ghc_5.bc'. 2. Running pass 'Greedy Register Allocator' on function '@"stg_atomically_frame_info$def"' `llc-3' failed in phase `LLVM Compiler'. (Exit code: -11) rts/ghc.mk:246: recipe for target 'rts/dist/build/PrimOps.o' failed }}} Seeing LLVM 3.6 break like this, I hacked `configure.ac` to accept `llvm-3.7` and then got: {{{ You are using a new version of LLVM that hasn't been tested yet! We will try though... /usr/bin/opt-3.7: /tmp/ghc24454_0/ghc_3.ll:22:21: error: expected comma after load's type %lnI = load i64** %Sp_Var ^ `opt-3' failed in phase `LLVM Optimiser'. (Exit code: 1) }}} It seems the LLVM IR has changed between llvm-3.6 and llvm-3.7 (again). -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:24 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by edmund): That error from opt-3.7 looks like a syntax error in the IR. If there had been a fundamental change in the IR's syntax then it would probably be mentioned in http://llvm.org/releases/3.7.0/docs/ReleaseNotes.html, but I don't see it mentioned there. Also, it says in https://www.reddit.com/r/haskell/comments/3nf3q1/improved_llvm_backend/: "There are tests in LLVM upstream for our needed features (including the new ones in LLVM 3.6+), so hopefully the scope for regressions is lower (indeed, crude hacks simply increase the cost of supporting it.) In fact, LLVM 3.7.0 worked perfectly on release, and we did some prerelease testing too." So I wouldn't be so sure that the problem you're seeing there is caused by the IR changing. Can you try using GHC with llvm-3.7 on x86_64? In general, an LLVM load instruction does contain at least one comma, I think (http://llvm.org/docs/LangRef.html#id201), so the line you quoted looks suspicious. Can you get GHC to generate some more IR and see what the other loads look like? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:25 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): ----------------------------------------+------------------------------- Comment (by erikd): Its not mentioned in the release notes, however the IR docs for the `load` for 3.7 are here : http://llvm.org/releases/3.7.0/docs/LangRef.html#load-instruction which gives as an example: {{{ %ptr = alloca i32 ; yields i32*:ptr store i32 3, i32* %ptr ; yields void %val = load i32, i32* %ptr ; yields i32:val = i32 3 }}} For 3.6 the docs are here: http://llvm.org/releases/3.6.0/docs/LangRef.html#load-instruction and the example is: {{{ %ptr = alloca i32 ; yields i32*:ptr store i32 3, i32* %ptr ; yields void %val = load i32* %ptr ; yields i32:val = i32 3 }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:26 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): I have a patch in progress that allows building GHC with llvm-3.7 and `BuildFlavour=quick-llvm` on x86_64. In the process of testing that on arm64. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:27 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): It lives! GHC now builds registerised, with the LLVM backend in the `wip/aarch64-regd` branch in the GHC git repo. Need to clean it up and will then put it through Phab. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:28 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by edmund): That's excellent! Some questions: - Did you run the testsuite? - Are there any regressions? - Is concurrency ("-threaded") now enabled? - Did that get tested by the testsuite? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:29 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): Haven't run the test suite yet, but I know GHCi is busted: {{{ ghc-stage2: panic! (the 'impossible' happened) (GHC version 7.11.20151009 for aarch64-unknown-linux): mkJumpToAddr not defined for ArchARM64 }}} Working on a fix for that. Yes, threaded is working. Probably not going to get much time to work on this until Monday. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:30 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): There is definitely some work to do: {{{ OVERALL SUMMARY for test run started at Sat Oct 10 08:41:17 2015 UTC 0:28:32 spent to go through 4693 total tests, which gave rise to 14892 test cases, of which 10249 were skipped 72 had missing libraries 4146 expected passes 100 expected failures 21 caused framework failures 0 unexpected passes 307 unexpected failures 14 unexpected stat failures }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:31 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): I now seem to have GHCi working as well. Current version is in the `wip/aarch64-regd` branch of the main repo. Tomorrow I will clean this up and submit a Phab review. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:32 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): Now that GHCi is working: {{{ OVERALL SUMMARY for test run started at Mon Oct 12 08:37:45 2015 UTC 0:30:52 spent to go through 4695 total tests, which gave rise to 14901 test cases, of which 10255 were skipped 72 had missing libraries 4284 expected passes 100 expected failures 22 caused framework failures 0 unexpected passes 172 unexpected failures 14 unexpected stat failures }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:33 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by edmund): That sounds good! Are you sure that commit cc4522de4b60d975836a444a61a123011a496349 ("Fix clobbered regs list for aarch64 StgRun") is correct and necessary? Firstly, why is "%d15" missing from the list? Secondly, why are callee- save registers being saved and restored by the assembly code AND being described as clobbered so that the C compiler generates code to save and restore them? Isn't that just going to result in all those registers being saved and restored twice? However, it presumably doesn't hurt the correctness, so perhaps you should for now just add "%d15" to the list and insert a warning comment: "Callee- save registers are perhaps being saved and restored twice, redundantly!" -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:34 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): Yep, added `%d15` to the clobbered regs list and added a comment along the lines you suggested. As usual its in the `wip/aarch64-regd` in the GHC git repo. Behavour as expected is unchanged. Currently have ~170 test failing. Choosing one, pretty much at random, I notice that it fails in three different ways (as do many of the other failing tests): {{{ $ inplace/bin/ghc-stage2 -O -v0 -fforce-recomp \ testsuite/tests/numeric/should_run/T7014.hs -o a.out Illegal instruction (core dumped) $ inplace/bin/ghc-stage2 -O -v0 -fforce-recomp \ testsuite/tests/numeric/should_run/T7014.hs -o a.out Segmentation fault (core dumped) $ inplace/bin/ghc-stage2 -O -v0 -fforce-recomp \ testsuite/tests/numeric/should_run/T7014.hs -o a.out Bus error (core dumped) }}} Even after disabling ASLR (Address space layout randomization) it still fails in at least two ways. The above failure only happens with optimisation (`-O`) turned on. As usual, GDB provides nothing but a very poor backtrace: {{{ Program received signal SIGSEGV, Segmentation fault. 0x000006d6f9400288 in ?? () (gdb) bt #0 0x000006d6f9400288 in ?? () #1 0x0000007fb6db8ca4 in cwTZ_info$def () from .../libHSghc-7.11.20151019-ghc7.11.20151019.so }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:35 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): Same problem compiling the most trivial "hello world" program. Without optimisation it compiles fine and the result executable works correctly. With optimisation the compiler crashes with a segfault. Add `-dshow-passes` results in: {{{ $ inplace/bin/ghc-stage2 hello-world.hs -O1 -dshow-passes -fforce-recomp -o \ hello-world Glasgow Haskell Compiler, Version 7.11.20151019, stage 2 booted by GHC version \ 7.8.4 Using binary package database: /home/erikd/ghc-upstream/inplace/lib/ package.conf.d/package.cache wired-in package ghc-prim mapped to ghc-prim-0.4.0.0 wired-in package integer-gmp mapped to integer-gmp-1.0.0.0 wired-in package base mapped to base-4.8.2.0 wired-in package rts mapped to rts wired-in package template-haskell mapped to template-haskell-2.11.0.0 wired-in package ghc mapped to ghc-7.11.20151019 wired-in package dph-seq not found. wired-in package dph-par not found. wired-in package ghc-prim mapped to ghc-prim-0.4.0.0 wired-in package integer-gmp mapped to integer-gmp-1.0.0.0 wired-in package base mapped to base-4.8.2.0 wired-in package rts mapped to rts-1.0 wired-in package template-haskell mapped to template-haskell-2.11.0.0 wired-in package ghc mapped to ghc-7.11.20151019 wired-in package dph-seq not found. wired-in package dph-par not found. *** Chasing dependencies: Chasing modules from: *hello-world.hs Stable obj: [] Stable BCO: [] Ready for upsweep [NONREC ModSummary { ms_hs_date = 2015-10-19 23:10:28.96994973 UTC ms_mod = Main, ms_textual_imps = [(Nothing, Prelude)] ms_srcimps = [] }] *** Deleting temp files: compile: input file hello-world.hs *** Checking old interface for Main: [1 of 1] Compiling Main ( hello-world.hs, hello-world.o ) *** Parser: *** Renamer/typechecker: *** Desugar: Result size of Desugar (after optimization) = {terms: 7, types: 5, coercions: 0} *** Simplifier: Result size of Simplifier iteration=1 = {terms: 11, types: 10, coercions: 0} Result size of Simplifier = {terms: 11, types: 10, coercions: 0} *** Specialise: Illegal instruction (core dumped) }}} Regardless of the above, this is almost certainly an LLVM or linker problem. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:36 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by edmund): You're quoting cases of ghc-stage2 segfaulting. Presumably that's because ghc-stage1 generated bad code. And I'm guessing both stage1 and stage2 are registerised. It would be nice if you could find a simple program that gets compiled incorrectly, and to get that you could either run the test suite with the stage1 compiler (bearing in mind that some tests are expected to fail with a stage1 compiler) or find a way of building a registerised stage2 using an unregisterised stage1 (which doesn't appear to be entirely straightforward with the way the build infrastructure works). What do you think? You can tell GDB "info reg" and "x/i 0x0000007fb6db8ca4" to find out how it got from there to 0x000006d6f9400288. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:37 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by edmund): Does {{{( cd testsuite && make TEST=ado001 stage=1 )}}} fail for you on arm64? Does it pass on other architectures? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:38 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): The test `( cd testsuite && make TEST=ado001 stage=1 )` passes on arm64. Running the whole test suite like that and I get a number of failures due to the fact that its only the stage1 compiler (ie all ghci, TH and annoations tests), but I also get this one failing: {{{ make test stage=1 TEST="T5435_v_asm" }}} but that passes on x86_64. Sure enough, looking at `rts/Linker.c` there is no `aarch64_ HOST_ARCH` section. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:39 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: 8.0.1 Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Comment (by erikd): Have a simple Make script that passes on x86_64/linux and fails on arm64/linux: {{{ #!/usr/bin/make -f GHC = inplace/bin/ghc-stage1 GHCFLAGS = -fforce-recomp -dcore-lint -dcmm-lint -dno-debug-output \ -no-user-package-db -rtsopts -fno-warn-tabs \ -fno-warn-missed-specialisations -optc-Dlinux_HOST_OS=1 -v0 TESTDIR = testsuite/tests/rts all : rm -f *.o $(GHC) $(GHCFLAGS) -c $(TESTDIR)/T5435_asm.c -o T5435_load_v_asm.o $(GHC) $(GHCFLAGS) $(TESTDIR)/T5435.hs -o T5435_v_asm ./T5435_v_asm v ./T5435_load_v_asm.o }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:40 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#10383: AArch64: get GHC Calling convention working ----------------------------------------+------------------------------- Reporter: erikd | Owner: erikd Type: feature request | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.11 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: aarch64 Type of failure: Building GHC failed | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | ----------------------------------------+------------------------------- Changes (by bgamari): * milestone: 8.2.1 => Comment: De-milestoning due to lack of progress. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/10383#comment:42 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC