- = let (stixRaw, us1) = initUs us (genCodeAbstractC absC)
- stixOpt = map (map genericOpt) stixRaw
- insns = initUs_ us1 (codeGen stixOpt)
- debug_stix = vcat (map pprStixTrees stixOpt)
- in
- (debug_stix, insns)
+ = let absCstmts = mkAbsCStmtList absC
+ (sdoc_pairs, us1) = initUs us (lazyMapUs absCtoNat absCstmts)
+ stix_sdocs = map fst sdoc_pairs
+ insn_sdocs = map snd sdoc_pairs
+
+ insn_sdoc = my_vcat insn_sdocs
+ stix_sdoc = vcat stix_sdocs
+
+# ifdef NCG_DEBUG
+ my_trace m x = trace m x
+ my_vcat sds = vcat (intersperse (char ' '
+ $$ ptext SLIT("# ___ncg_debug_marker")
+ $$ char ' ')
+ sds)
+# else
+ my_vcat sds = vcat sds
+ my_trace m x = x
+# endif
+ in
+ my_trace "nativeGen: begin"
+ (stix_sdoc, insn_sdoc)
+
+
+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 ->
+ returnUs (stix_sdoc, final_sdoc)
+ where
+ bind f x = x f
+
+ x86fp_kludge :: [Instr] -> [Instr]
+ x86fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
+
+ regAlloc :: InstrBlock -> [Instr]
+ regAlloc = runRegAllocate allocatableRegs findReservedRegs