Permalink
Browse files

[project @ 1999-01-26 11:12:41 by simonm]

- Add Stable Names

- Stable pointers and stable names are now both provided by the
  "Stable" module in ghc/lib/exts.  Documentation is updated, and Foriegn
  still exports the stable pointer operations for backwards compatibility.
  • Loading branch information...
1 parent b311f13 commit ed4cd6d403d932026f38608f81c3a8872e38b2ce simonm committed Jan 26, 1999
@@ -1244,6 +1244,7 @@ pprUnionTag FloatRep = char 'f'
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
pprUnionTag StablePtrRep = char 'i'
+pprUnionTag StableNameRep = char 'p'
pprUnionTag WeakPtrRep = char 'p'
pprUnionTag ForeignObjRep = char 'p'
@@ -160,8 +160,9 @@ module Unique (
stablePtrDataConKey,
stablePtrPrimTyConKey,
stablePtrTyConKey,
- stateDataConKey,
- stateTyConKey,
+ stableNameDataConKey,
+ stableNamePrimTyConKey,
+ stableNameTyConKey,
statePrimTyConKey,
typeConKey,
@@ -517,8 +518,9 @@ rationalTyConKey = mkPreludeTyConUnique 31
realWorldTyConKey = mkPreludeTyConUnique 32
stablePtrPrimTyConKey = mkPreludeTyConUnique 33
stablePtrTyConKey = mkPreludeTyConUnique 34
-stateTyConKey = mkPreludeTyConUnique 50
-statePrimTyConKey = mkPreludeTyConUnique 51
+statePrimTyConKey = mkPreludeTyConUnique 35
+stableNamePrimTyConKey = mkPreludeTyConUnique 50
+stableNameTyConKey = mkPreludeTyConUnique 51
mutableByteArrayTyConKey = mkPreludeTyConUnique 52
mutVarPrimTyConKey = mkPreludeTyConUnique 53
ioTyConKey = mkPreludeTyConUnique 55
@@ -562,7 +564,7 @@ foreignObjDataConKey = mkPreludeDataConUnique 13
nilDataConKey = mkPreludeDataConUnique 14
ratioDataConKey = mkPreludeDataConUnique 15
stablePtrDataConKey = mkPreludeDataConUnique 16
-stateDataConKey = mkPreludeDataConUnique 33
+stableNameDataConKey = mkPreludeDataConUnique 17
trueDataConKey = mkPreludeDataConUnique 34
wordDataConKey = mkPreludeDataConUnique 35
word8DataConKey = mkPreludeDataConUnique 36
@@ -21,8 +21,13 @@ import OrdList ( OrdList )
import PrimOp ( commutableOp, PrimOp(..) )
import RegAllocInfo ( mkMRegsState, MRegsState )
import Stix ( StixTree(..), StixReg(..) )
+import PrimRep ( isFloatingRep )
import UniqSupply ( returnUs, thenUs, mapUs, 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
@@ -85,7 +90,14 @@ runNCG absC
let
stix = map (map genericOpt) treelists
in
+#if i386_TARGET_ARCH
+ let
+ stix' = map floatFix stix
+ in
+ codeGen stix'
+#else
codeGen stix
+#endif
\end{code}
@codeGen@ is the top-level code-generation function:
@@ -282,3 +294,64 @@ Anything else is just too hard.
\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 label tree) =
+ StCondJump label (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}
@@ -171,6 +171,7 @@ prim_tycons
, mutVarPrimTyCon
, realWorldTyCon
, stablePtrPrimTyCon
+ , stableNamePrimTyCon
, statePrimTyCon
, threadIdPrimTyCon
, wordPrimTyCon
@@ -459,9 +460,9 @@ byteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("ByteArray"))
mutableByteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("MutableByteArray"))
foreignObjTyCon_RDR = tcQual (pREL_IO_BASE, SLIT("ForeignObj"))
-stablePtrTyCon_RDR = tcQual (pREL_FOREIGN, SLIT("StablePtr"))
-deRefStablePtr_RDR = varQual (pREL_FOREIGN, SLIT("deRefStablePtr"))
-makeStablePtr_RDR = varQual (pREL_FOREIGN, SLIT("makeStablePtr"))
+stablePtrTyCon_RDR = tcQual (pREL_STABLE, SLIT("StablePtr"))
+deRefStablePtr_RDR = varQual (pREL_STABLE, SLIT("deRefStablePtr"))
+makeStablePtr_RDR = varQual (pREL_STABLE, SLIT("makeStablePtr"))
eqClass_RDR = tcQual (pREL_BASE, SLIT("Eq"))
ordClass_RDR = tcQual (pREL_BASE, SLIT("Ord"))
@@ -17,6 +17,7 @@ module PrelMods
pREL_GHC, pRELUDE, mONAD, rATIO, iX, mAIN, pREL_MAIN, pREL_ERR,
pREL_BASE, pREL_NUM, pREL_LIST, pREL_TUP, pREL_ADDR, pREL_READ,
pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR, pREL_FOREIGN,
+ pREL_STABLE,
iNT, wORD
) where
@@ -31,7 +32,8 @@ import Panic ( panic )
\begin{code}
pREL_GHC, pRELUDE, mONAD, rATIO, iX, mAIN, pREL_MAIN, pREL_ERR :: Module
pREL_BASE, pREL_NUM, pREL_LIST, pREL_TUP, pREL_ADDR, pREL_READ :: Module
-pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR, pREL_FOREIGN :: Module
+pREL_PACK, pREL_CONC, pREL_IO_BASE, pREL_ST, pREL_ARR :: Module
+pREL_FOREIGN, pREL_STABLE :: Module
pRELUDE = mkModule "Prelude"
@@ -47,6 +49,7 @@ pREL_IO_BASE = mkModule "PrelIOBase"
pREL_ST = mkModule "PrelST"
pREL_ARR = mkModule "PrelArr"
pREL_FOREIGN = mkModule "PrelForeign"
+pREL_STABLE = mkModule "PrelStable"
pREL_ADDR = mkModule "PrelAddr"
pREL_ERR = mkModule "PrelErr"
Oops, something went wrong.

0 comments on commit ed4cd6d

Please sign in to comment.