diff options
| author | sewardj <unknown> | 2001-02-19 10:15:54 +0000 |
|---|---|---|
| committer | sewardj <unknown> | 2001-02-19 10:15:54 +0000 |
| commit | 0879ee328b8d52877f82fda4ae2a234b5ba6c037 (patch) | |
| tree | 54b434b30dfc434c706381d18485472e3faa51a1 /ghc/compiler/nativeGen/AsmCodeGen.lhs | |
| parent | ec594d7e5a09e21df719859a7724adb1394ce60e (diff) | |
| download | haskell-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.lhs | 24 |
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) |