X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixPrim.lhs;h=ff5332df1ac035bc99912e1561937442a8d80b10;hb=e2a7f07969b47fef0cdf284e1bf98a0ad7b01d76;hp=588efa7571edc3cf47f9237732b3af469c8ae8a8;hpb=95585c35917515db927f0397b58eda4c8525b481;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 588efa7..ff5332d 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -14,6 +14,7 @@ import StixInteger import AbsCSyn hiding ( spRel ) import AbsCUtils ( getAmodeRep, mixedTypeLocn ) +import Constants ( uF_UPDATEE ) import SMRep ( fixedHdrSize ) import Const ( Literal(..) ) import CallConv ( cCallConv ) @@ -158,7 +159,7 @@ primCode [] WriteArrayOp [obj, ix, v] obj' = amodeToStix obj ix' = amodeToStix ix v' = amodeToStix v - base = StIndex IntRep obj' arrHS + base = StIndex IntRep obj' arrHS --(StInt (toInteger 3)) assign = StAssign PtrRep (StInd PtrRep (StIndex PtrRep base ix')) v' in returnUs (\xs -> assign : xs) @@ -351,7 +352,7 @@ amodeToStix (CCharLike (CLit (MachChar c))) amodeToStix (CCharLike x) = StIndex PtrRep charLike off where - off = StPrim IntMulOp [amodeToStix x, StInt (toInteger (fixedHdrSize+1))] + off = StPrim IntMulOp [amodeToStix x, StInt (toInteger charLikeSize)] amodeToStix (CIntLike (CLit (MachInt i _))) = StLitLbl ((<>) (ptext SLIT("INTLIKE_closure+")) (int off)) @@ -367,13 +368,13 @@ amodeToStix (CLit core) MachStr s -> StString s MachAddr a -> StInt a MachInt i _ -> StInt (toInteger i) - MachLitLit s _ -> StLitLit s + MachLitLit s _ -> {-trace (_UNPK_ s ++ "\n")-} (litLitToStix (_UNPK_ s)) MachFloat d -> StDouble d MachDouble d -> StDouble d _ -> panic "amodeToStix:core literal" - -- A CLitLit is just a (CLit . MachLitLit) -amodeToStix (CLitLit s _) = StLitLit s +amodeToStix (CLitLit s _) + = litLitToStix (_UNPK_ s) amodeToStix (CMacroExpr _ macro [arg]) = case macro of @@ -383,10 +384,21 @@ amodeToStix (CMacroExpr _ macro [arg]) [StInd WordRep (StPrim IntSubOp [amodeToStix arg, StInt 1]), StInt 16] - + UPD_FRAME_UPDATEE + -> StInd PtrRep (StIndex PtrRep (amodeToStix arg) + (StInt (toInteger uF_UPDATEE))) -- XXX!!! -- GET_TAG(info_ptr) is supposed to be get_itbl(info_ptr)->srt_len, -- which we've had to hand-code here. + +litLitToStix :: String -> StixTree +litLitToStix nm + = case nm of + "stdout" -> stixFor_stdout + "stderr" -> stixFor_stderr + "stdin" -> stixFor_stdin + other -> error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" + ++ "suggested workaround: use flag -fvia-C\n") \end{code} Sizes of the CharLike and IntLike closures that are arranged as arrays