%
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
%
\begin{code}
-#include "HsVersions.h"
+module AsmCodeGen ( nativeCodeGen ) where
-module AsmCodeGen ( writeRealAsm, dumpRealAsm ) where
+#include "HsVersions.h"
-IMP_Ubiq(){-uitous-}
-IMPORT_1_3(IO(Handle))
+import IO ( Handle )
+import List ( intersperse )
import MachMisc
import MachRegs
import AsmRegAlloc ( runRegAllocate )
import OrdList ( OrdList )
import PrimOp ( commutableOp, PrimOp(..) )
-import PrimRep ( PrimRep{-instance Eq-} )
import RegAllocInfo ( mkMRegsState, MRegsState )
-import Stix ( StixTree(..), StixReg(..), CodeSegment )
-import UniqSupply ( returnUs, thenUs, mapUs, SYN_IE(UniqSM) )
-import Unpretty ( uppPutStr, uppShow, uppAboves, SYN_IE(Unpretty) )
+import Stix ( StixTree(..), StixReg(..), pprStixTrees )
+import PrimRep ( isFloatingRep )
+import UniqSupply ( returnUs, thenUs, mapUs, initUs,
+ initUs_, UniqSM, UniqSupply )
+import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
+import Outputable
+
+import GlaExts (trace) --tmp
+#include "nativeGen/NCG.h"
\end{code}
The 96/03 native-code generator has machine-independent and
machine instructions.
\item[@PprMach@:] @pprInstr@ turns an @Instr@ into text (well, really
- an @Unpretty@).
+ an @Doc@).
\item[@RegAllocInfo@:] In the register allocator, we manipulate
@MRegsState@s, which are @BitSet@s, one bit per machine register.
\end{description}
So, here we go:
-\begin{code}
-writeRealAsm :: Handle -> AbstractC -> UniqSupply -> IO ()
-
-writeRealAsm handle absC us
- = _scc_ "writeRealAsm" (uppPutStr handle 80 (runNCG absC us))
-
-dumpRealAsm :: AbstractC -> UniqSupply -> String
-dumpRealAsm absC us = uppShow 80 (runNCG absC us)
-
-runNCG absC
- = genCodeAbstractC absC `thenUs` \ treelists ->
- let
- stix = map (map genericOpt) treelists
- in
- codeGen stix
+\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]] -> UniqSM Unpretty
+codeGen :: [[StixTree]] -> UniqSM SDoc
-codeGen trees
- = mapUs genMachCode trees `thenUs` \ dynamic_codes ->
+codeGen stixFinal
+ = mapUs genMachCode stixFinal `thenUs` \ dynamic_codes ->
let
- static_instrs = scheduleMachCode dynamic_codes
+ static_instrss = scheduleMachCode dynamic_codes
+ docs = map (vcat . map pprInstr) static_instrss
in
- returnUs (uppAboves (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}
genericOpt (StCondJump addr test)
= StCondJump addr (genericOpt test)
-genericOpt (StCall fn pk args)
- = StCall fn pk (map genericOpt args)
+genericOpt (StCall fn cconv pk args)
+ = StCall fn cconv pk (map genericOpt args)
\end{code}
Fold indices together when the types match:
primOpt op arg@[StInt x]
= case op of
IntNegOp -> StInt (-x)
- IntAbsOp -> StInt (abs x)
_ -> StPrim op arg
primOpt op args@[StInt x, StInt y]
IntNeOp -> StInt (if x /= y then 1 else 0)
IntLtOp -> StInt (if x < y then 1 else 0)
IntLeOp -> StInt (if x <= y then 1 else 0)
+ -- ToDo: WordQuotOp, WordRemOp.
_ -> StPrim op args
\end{code}
IntMulOp -> y
AndOp -> y
OrOp -> x
+ XorOp -> x
SllOp -> x
- SraOp -> x
SrlOp -> x
ISllOp -> x
ISraOp -> x
= case op of
IntMulOp -> case exactLog2 n of
Nothing -> StPrim op args
- Just p -> StPrim SllOp [x, StInt p]
+ Just p -> StPrim ISllOp [x, StInt p]
IntQuotOp -> case exactLog2 n of
Nothing -> StPrim op args
- Just p -> StPrim SraOp [x, StInt p]
+ Just p -> StPrim ISrlOp [x, StInt p]
_ -> StPrim op args
\end{code}