[GHC] #15179: Unwinding info for stg_ap_v_info is wrong
GHC
ghc-devs at haskell.org
Tue May 22 16:02:12 UTC 2018
#15179: Unwinding info for stg_ap_v_info is wrong
-------------------------------------+-------------------------------------
Reporter: niteria | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.5
(Debugging) |
Resolution: | Keywords:
Operating System: Linux | Architecture:
Type of failure: Debugging | Unknown/Multiple
information is incorrect | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by niteria):
The beginning of `stg_ap_v_info` looks like this:
{{{
INFO_TABLE_RET(stg_ap_v, RET_SMALL, W_ info_ptr, )
{
W_ info;
W_ arity;
unwind Sp = Sp + WDS(1);
IF_DEBUG(apply,foreign "C" debugBelch("stg_ap_v_ret... "); foreign "C"
printClosure(R1 "ptr"));
IF_DEBUG(sanity,foreign "C" checkStackFrame(Sp+WDS(1)"ptr"));
again:
if (GETTAG(R1)==1) {
Sp_adj(1);
jump %GET_ENTRY(R1-1) [R1];
}
...
}}}
This looks reasonable, and you'd expect the beginning to unwind to the
next word on the stack based on the manual annotation here.
The Parsed Cmm also looks reasonable:
{{{
==================== Parsed Cmm ====================
[section ""cstring" . c8_str" {
c8_str:
I8[] [115,116,103,95,97,112,95,118,95,114,101,116]
},
stg_ap_v_ret() // []
{ info_tbl: [(c13,
label: stg_ap_v_info
rep:tag:30 StackRep [])]
stack_info: arg_space: 8 updfr_space: Just 8
}
{offset
c13: // c1
//tick src<AutoApply.cmm:(8,1)-(95,1)>
unwind Sp = Just Sp + 1 * 8; // CmmUnwind
goto c4; // CmmBranch
c4: // c1
if (R1 & ((1 << 3) - 1) == 1) goto c5; else goto c7;
// CmmCondBranch
c5: // c1
//tick src<AutoApply.cmm:(17,35)-(20,5)>
//tick src<AutoApply.cmm:18:12-26>
Sp = Sp + 1 * 8; // CmmAssign
call (I64[R1 - 1])(R1) args: 8, res: 0, upd: 8; //
CmmCall
...
}}}
and it survives in this form till the very end of the Cmm pipeline, that
is into Optimised Cmm:
{{{
==================== Optimised Cmm ====================
stg_ap_v_ret() // []
{ [(c13,
stg_ap_v_info:
const 0;
const 30;)]
}
{offset
c13: // c1
//tick src<AutoApply.cmm:(8,1)-(95,1)>
unwind Sp = Just Sp + 8; // CmmUnwind
goto c4; // CmmBranch
c4: // c1
if (R1 & 7 == 1) goto c5; else goto c7; // CmmCondBranch
c5: // c1
//tick src<AutoApply.cmm:(17,35)-(20,5)>
//tick src<AutoApply.cmm:18:12-26>
Sp = Sp + 8; // CmmAssign
call (I64[R1 - 1])(R1) args: 8, res: 0, upd: 8; // CmmCall
...
}}}
The Native code preserves the c13 label which is where we have our unwind
info:
{{{
==================== Native code ====================
.section .text
.align 8
.align 8
.loc 1 8 1
.quad 0
.quad 30
.globl stg_ap_v_info
.type stg_ap_v_info, @object
stg_ap_v_info:
_c13:
.loc 1 8 1
_n1b:
jmp _c4
.Lc13_end:
_c4:
.loc 1 8 1
movq %rbx,%vI_n1d
andl $7,%vI_n1d
cmpq $1,%vI_n1d
je _c5
jmp _c7
.Lc4_end:
_c5:
.loc 1 8 1
addq $8,%rbp
jmp *-1(%rbx)
.Lc5_end:
...
==================== Asm code ====================
.file 1 "AutoApply.cmm"
.section .text
.align 8
.align 8
.loc 1 8 1
.quad 0
.quad 30
.globl stg_ap_v_info
.type stg_ap_v_info, @object
stg_ap_v_info:
_c13:
.loc 1 8 1
_n1b:
.Lc13_end:
_c4:
.loc 1 8 1
movq %rbx,%rax
andl $7,%eax
cmpq $1,%rax
je _c5
.Lc4_end:
_c7:
.loc 1 8 1
andq $-8,%rbx
movq (%rbx),%rax
cmpl $58,-8(%rax)
jb _u14
.Lc7_end:
}}}
Debug Infos keeps our unwind info attached to c13:
{{{
==================== Debug Infos ====================
proc c13 (stg_ap_v_info) src<AutoApply.cmm:(8,1)-(95,1)> removed [{_n1b:
Sp=Just Sp+8}] [blk c4 (_c4) src<AutoApply.cmm:(8,1)-(95,1)> pos 0 [],
blk c7 (_c7) src<AutoApply.cmm:(8,1)-(95,1)> pos 1 [],
blk u18 (_u18) src<AutoApply.cmm:(8,1)-(95,1)> pos 2 [],
blk u14 (_u14) src<AutoApply.cmm:(8,1)-(95,1)> pos 4 [],
blk u17 (_u17) src<AutoApply.cmm:(8,1)-(95,1)> pos 5 [],
blk u15 (_u15) src<AutoApply.cmm:(8,1)-(95,1)> pos 35 [],
blk u16 (_u16) src<AutoApply.cmm:(8,1)-(95,1)> pos 36 [],
blk c5 (_c5) src<AutoApply.cmm:(8,1)-(95,1)> pos 34 [],
blk cb (_cb) src<AutoApply.cmm:(91,18)-(93,9)> pos 3 [{_n1f: MachSp=Just
MachSp+8},
{_n1g: MachSp=Just MachSp}],
blk cp (_cp) src<AutoApply.cmm:(27,18)-(36,9)> pos 27 [] [blk ce (_ce)
src<AutoApply.cmm:(27,18)-(36,9)> pos 28 [],
blk ck (_ck) src<AutoApply.cmm:(27,18)-(36,9)> pos 29 [],
blk cl (_cl) src<AutoApply.cmm:(27,18)-(36,9)> pos 30 [],
blk cm (_cm) src<AutoApply.cmm:(27,18)-(36,9)> pos 31 [],
blk cc (_cc) src<AutoApply.cmm:(27,18)-(36,9)> pos 32 []],
blk cG (_cG) src<AutoApply.cmm:(43,18)-(56,9)> pos 20 [] [blk cs (_cs)
src<AutoApply.cmm:(43,18)-(56,9)> pos 21 [],
blk ct (_ct) src<AutoApply.cmm:(43,18)-(56,9)> pos 22 [],
blk cu (_cu) src<AutoApply.cmm:(43,18)-(56,9)> pos 23 [],
blk cB (_cB) src<AutoApply.cmm:(43,18)-(56,9)> pos 24 [],
blk cC (_cC) src<AutoApply.cmm:(43,18)-(56,9)> pos 25 [],
blk cD (_cD) src<AutoApply.cmm:(43,18)-(56,9)> pos 26 [],
blk cq (_cq) src<AutoApply.cmm:(43,18)-(56,9)> pos 18 [],
blk co (_co) src<AutoApply.cmm:54:596-601> pos 19 [],
blk cO (_cO) src<AutoApply.cmm:54:128-215> pos 16 []],
}}}
But c4 is the first label we generate the debug info for:
{{{
==================== Asm code ====================
.Lsection_info:
.section .debug_info,"", at progbits
_n1H:
.long .Ln1H_end-_n1H-4
.short 3
.long .Lsection_abbrev
.byte 8
.byte 1
.asciz "/tmp/ghc802745_0/ghc_1.cmm"
.asciz "The Glorious Glasgow Haskell Compilation System 8.5.20180514"
.long 24
.asciz "/data/users/bnitka/ghc-unwind-asm-2/"
.quad stg_ap_v_info
.quad .Lstg_ap_v_info_end
.long .Lsection_line
.Lstg_ap_v_info_die:
.byte 2
.asciz "stg_ap_v_ret"
.asciz "stg_ap_v_info"
.byte 255
.quad stg_ap_v_info
.quad .Lstg_ap_v_info_end
.byte 1
.byte 156
.Lc4_die:
.byte 5
.asciz "_c4"
.quad _c4
.quad .Lc4_end
.byte 6
.asciz "AutoApply.cmm"
.long 8
.short 1
.long 95
.short 2
.byte 6
.asciz "AutoApply.cmm"
.long 24
.short 8
.long 24
.short 33
.byte 6
.asciz "AutoApply.cmm"
.long 25
.short 10
.long 25
.short 26
.byte 6
.asciz "AutoApply.cmm"
.long 17
.short 35
.long 20
.short 6
.byte 6
.asciz "AutoApply.cmm"
.long 18
.short 12
.long 18
.short 27
.byte 0
}}}
Going back to the Debug Info's dump you can see that c13 has `"removed"`
in it, which refers to the `dblPosition` field which keeps the relative
position of the block in a procedure.
Later when we see that `dblPosition` is `"removed"` we don't generate a
debug info for it. `blockToDwarf` is where we decide not to use removed
blocks. [0]
But the block is clearly there in the Cmm and Asm output, so there's some
mismatch here.
The part of code that declares them missing is `cmmDebugLabels` [1].
It does so because the block only consists of "meta" instructions.
One way to avoid this problem is to say that `unwind` is not a meta
instruction.
Another workaround is to add unwind info under `again:` label, that puts
the `unwind` pseudo-instruction in the c4 block which has some real code.
I'm speculating here, but I think the reason that c13 block didn't
disappear in assembly is because we generate `.loc` from the tick. I don't
know where that happens yet, so a pointer would be helpful.
I don't know how to fix this in a robust way yet.
[0]
https://phabricator.haskell.org/diffusion/GHC/browse/master/compiler/nativeGen/Dwarf.hs$198-199
[1]
https://phabricator.haskell.org/diffusion/GHC/browse/master/compiler/cmm/Debug.hs$235
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15179#comment:1>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list