summaryrefslogtreecommitdiff
path: root/ghc/compiler/nativeGen/AsmCodeGen.lhs
diff options
context:
space:
mode:
authorsewardj <unknown>2001-02-19 10:15:54 +0000
committersewardj <unknown>2001-02-19 10:15:54 +0000
commit0879ee328b8d52877f82fda4ae2a234b5ba6c037 (patch)
tree54b434b30dfc434c706381d18485472e3faa51a1 /ghc/compiler/nativeGen/AsmCodeGen.lhs
parentec594d7e5a09e21df719859a7724adb1394ce60e (diff)
downloadhaskell-0879ee328b8d52877f82fda4ae2a234b5ba6c037.tar.gz
[project @ 2001-02-19 10:15:54 by sewardj]
Fix two bugs exposed when trying to boot HEAD on sparc with NCG and -O: 1. StScratchWords on sparc were in the wrong place; they were immediately above %fp and should have been immediately below. Fixed. Also removed a suspicious-looking "+1" in the x86 version of same. 2. (Potentially affects all platforms): Lift strings out from top-level literal data, and place them at the end of the block. The motivating example (bug) was: Stix: (DataSegment) Bogon.ping_closure : (Data P_ Addr.A#_static_info) (Data StgAddr (Str `alalal')) (Data P_ (0)) results in: .data .align 8 .global Bogon_ping_closure Bogon_ping_closure: .long Addr_Azh_static_info .long .Ln1a8 .Ln1a8: .byte 0x61 .byte 0x6C .byte 0x61 .byte 0x6C .byte 0x61 .byte 0x6C .byte 0x00 .long 0 ie, the Str is planted in-line, when what we really meant was to place a _reference_ to the string there. This is Way Wrong (tm). Fixed.
Diffstat (limited to 'ghc/compiler/nativeGen/AsmCodeGen.lhs')
-rw-r--r--ghc/compiler/nativeGen/AsmCodeGen.lhs24
1 files changed, 11 insertions, 13 deletions
diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index dd3f8bc697..60d9b4936b 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -112,13 +112,13 @@ nativeCodeGen absC us
absCtoNat :: AbstractC -> UniqSM (SDoc, SDoc)
absCtoNat absC
- = _scc_ "genCodeAbstractC" genCodeAbstractC absC `thenUs` \ stixRaw ->
- _scc_ "genericOpt" genericOpt stixRaw `bind` \ stixOpt ->
- _scc_ "genMachCode" genMachCode stixOpt `thenUs` \ pre_regalloc ->
- _scc_ "regAlloc" regAlloc pre_regalloc `bind` \ almost_final ->
- _scc_ "x86fp_kludge" x86fp_kludge almost_final `bind` \ final_mach_code ->
- _scc_ "vcat" vcat (map pprInstr final_mach_code) `bind` \ final_sdoc ->
- _scc_ "pprStixTrees" pprStixTrees stixOpt `bind` \ stix_sdoc ->
+ = _scc_ "genCodeAbstractC" genCodeAbstractC absC `thenUs` \ stixRaw ->
+ _scc_ "genericOpt" genericOpt stixRaw `bind` \ stixOpt ->
+ _scc_ "genMachCode" genMachCode stixOpt `thenUs` \ pre_regalloc ->
+ _scc_ "regAlloc" regAlloc pre_regalloc `bind` \ almost_final ->
+ _scc_ "x86fp_kludge" x86fp_kludge almost_final `bind` \ final_mach_code ->
+ _scc_ "vcat" vcat (map pprInstr final_mach_code) `bind` \ final_sdoc ->
+ _scc_ "pprStixTrees" pprStixTrees stixOpt `bind` \ stix_sdoc ->
returnUs (stix_sdoc, final_sdoc)
where
bind f x = x f
@@ -150,12 +150,10 @@ supply breaks abstraction. Is that bad?
genMachCode :: [StixTree] -> UniqSM InstrBlock
genMachCode stmts initial_us
- = let initial_st = mkNatM_State initial_us 0
- (blocks, final_st) = initNat initial_st
- (mapNat stmt2Instrs stmts)
- instr_list = concatOL blocks
- final_us = uniqOfNatM_State final_st
- final_delta = deltaOfNatM_State final_st
+ = let initial_st = mkNatM_State initial_us 0
+ (instr_list, final_st) = initNat initial_st (stmtsToInstrs stmts)
+ final_us = uniqOfNatM_State final_st
+ final_delta = deltaOfNatM_State final_st
in
if final_delta == 0
then (instr_list, final_us)