module AsmCodeGen ( nativeCodeGen ) where
#include "HsVersions.h"
+#include "nativeGen/NCG.h"
import IO ( Handle )
+import List ( intersperse )
import MachMisc
import MachRegs
import RegAllocInfo ( mkMRegsState, MRegsState )
import Stix ( StixTree(..), StixReg(..), pprStixTrees )
import PrimRep ( isFloatingRep )
-import UniqSupply ( returnUs, thenUs, mapUs, initUs_, UniqSM, UniqSupply )
+import UniqSupply ( returnUs, thenUs, mapUs, initUs,
+ initUs_, UniqSM, UniqSupply )
import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
+import MachMisc ( IF_ARCH_i386(i386_insert_ffrees,) )
+
import Outputable
-import GlaExts (trace) --tmp
-#include "nativeGen/NCG.h"
\end{code}
The 96/03 native-code generator has machine-independent and
\end{description}
So, here we go:
-\begin{code}
-nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc, SDoc, SDoc)
-nativeCodeGen absC us = initUs_ us (runNCG absC)
-runNCG :: AbstractC -> UniqSM (SDoc, SDoc, SDoc, SDoc)
-runNCG absC
- = genCodeAbstractC absC `thenUs` \ stixRaw ->
- let
- stixOpt = map (map genericOpt) stixRaw
-#if i386_TARGET_ARCH
- stixFinal = map floatFix stixOpt
-#else
- stixFinal = stixOpt
-#endif
- in
- codeGen (stixRaw, stixOpt, stixFinal)
+\begin{code}
+nativeCodeGen :: AbstractC -> UniqSupply -> (SDoc, SDoc)
+nativeCodeGen absC us
+ = 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)
\end{code}
@codeGen@ is the top-level code-generation function:
\begin{code}
-codeGen :: ([[StixTree]],[[StixTree]],[[StixTree]])
- -> UniqSM (SDoc, SDoc, SDoc, SDoc)
+codeGen :: [[StixTree]] -> UniqSM SDoc
-codeGen (stixRaw, stixOpt, stixFinal)
+codeGen stixFinal
= mapUs genMachCode stixFinal `thenUs` \ dynamic_codes ->
let
- static_instrs = scheduleMachCode dynamic_codes
+ fp_kludge :: [Instr] -> [Instr]
+ fp_kludge = IF_ARCH_i386(i386_insert_ffrees,id)
+
+ static_instrss :: [[Instr]]
+ static_instrss = map fp_kludge (scheduleMachCode dynamic_codes)
+ docs = map (vcat . map pprInstr) static_instrss
in
- returnUs (
- text "ppr'd stixRaw",
- text "ppr'd stixOpt",
- vcat (map pprStixTrees stixFinal),
- vcat (map pprInstr static_instrs)
- )
+ returnUs (vcat (intersperse (char ' '
+ $$ text "# ___stg_split_marker"
+ $$ char ' ')
+ docs))
\end{code}
Top level code generator for a chunk of stix code:
might be needed.
\begin{code}
-scheduleMachCode :: [InstrList] -> [Instr]
+scheduleMachCode :: [InstrList] -> [[Instr]]
scheduleMachCode
- = concat . map (runRegAllocate freeRegsState reservedRegs)
+ = map (runRegAllocate freeRegsState reservedRegs)
where
freeRegsState = mkMRegsState (extractMappedRegNos freeRegs)
\end{code}
\begin{code}
primOpt op args = StPrim op args
\end{code}
-
------------------------------------------------------------------------------
-Fix up floating point operations for x86.
-
-The problem is that the code generator can't handle the weird register
-naming scheme for floating point registers on the x86, so we have to
-deal with memory-resident floating point values wherever possible.
-
-We therefore can't stand references to floating-point kinded temporary
-variables, and try to translate them into memory addresses wherever
-possible.
-
-\begin{code}
-floatFix :: [StixTree] -> [StixTree]
-floatFix trees = fltFix emptyUFM trees
-
-fltFix :: UniqFM StixTree -- mapping tmp vars to memory locations
- -> [StixTree]
- -> [StixTree]
-fltFix locs [] = []
-
--- The case we're interested in: loading a temporary from a memory
--- address. Eliminate the instruction and replace all future references
--- to the temporary with the memory address.
-fltFix locs ((StAssign rep (StReg (StixTemp uq _)) loc) : trees)
- | isFloatingRep rep = trace "found one" $ fltFix (addToUFM locs uq loc) trees
-
-fltFix locs ((StAssign rep src dst) : trees)
- = StAssign rep (fltFix1 locs src) (fltFix1 locs dst) : fltFix locs trees
-
-fltFix locs (tree : trees)
- = fltFix1 locs tree : fltFix locs trees
-
-
-fltFix1 :: UniqFM StixTree -> StixTree -> StixTree
-fltFix1 locs r@(StReg (StixTemp uq rep))
- | isFloatingRep rep = case lookupUFM locs uq of
- Nothing -> panic "fltFix1"
- Just tree -> trace "substed" $ tree
-
-fltFix1 locs (StIndex rep l r) =
- StIndex rep (fltFix1 locs l) (fltFix1 locs r)
-
-fltFix1 locs (StInd rep tree) =
- StInd rep (fltFix1 locs tree)
-
-fltFix1 locs (StAssign rep dst src) = panic "fltFix1: StAssign"
-
-fltFix1 locs (StJump tree) = StJump (fltFix1 locs tree)
-
-fltFix1 locs (StCondJump lbl tree) =
- StCondJump lbl (fltFix1 locs tree)
-
-fltFix1 locs (StPrim op trees) =
- StPrim op (map (fltFix1 locs) trees)
-
-fltFix1 locs (StCall f conv rep trees) =
- StCall f conv rep (map (fltFix1 locs) trees)
-
-fltFix1 locs tree = tree
-\end{code}