ghc/compiler/nativeGen/StixPrim.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
   7
   8 #include "HsVersions.h"
   9
  10 import MachMisc
  11 import Stix
  12 import StixInteger
  13
  14 import AbsCSyn          hiding ( spRel )
  15 import AbsCUtils        ( getAmodeRep, mixedTypeLocn )
  16 import SMRep            ( fixedHdrSize )
  17 import Literal          ( Literal(..), word2IntLit )
  18 import PrimOp           ( PrimOp(..), CCall(..), CCallTarget(..) )
  19 import PrimRep          ( PrimRep(..), isFloatingRep )
  20 import UniqSupply       ( returnUs, thenUs, getUniqueUs, UniqSM )
  21 import Constants        ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
  22                           rESERVED_STACK_WORDS )
  23 import CLabel           ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
  24                           mkMAP_FROZEN_infoLabel, mkForeignLabel )
  25 import Outputable
  26
  27 import Char             ( ord, isAlpha, isDigit )
  28
  29 #include "NCG.h"
  30 \end{code}
  31
  32 The main honcho here is primCode, which handles the guts of COpStmts.
  33
  34 \begin{code}
  35 primCode
  36     :: [CAddrMode]      -- results
  37     -> PrimOp           -- op
  38     -> [CAddrMode]      -- args
  39     -> UniqSM StixTreeList
  40 \end{code}
  41
  42 First, the dreaded @ccall@.  We can't handle @casm@s.
  43
  44 Usually, this compiles to an assignment, but when the left-hand side
  45 is empty, we just perform the call and ignore the result.
  46
  47 btw Why not let programmer use casm to provide assembly code instead
  48 of C code?  ADR
  49
  50 The (MP) integer operations are a true nightmare.  Since we don't have
  51 a convenient abstract way of allocating temporary variables on the (C)
  52 stack, we use the space just below HpLim for the @MP_INT@ structures,
  53 and modify our heap check accordingly.
  54
  55 \begin{code}
  56 -- NB: ordering of clauses somewhere driven by
  57 -- the desire to getting sane patt-matching behavior
  58 primCode res@[sr,dr] IntegerNegOp arg@[sa,da]
  59   = gmpNegate (sr,dr) (sa,da)
  60
  61 primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2]
  62   = gmpCompare res (sa1,da1, sa2,da2)
  63
  64 primCode [res] IntegerCmpIntOp args@[sa1,da1,ai]
  65   = gmpCompareInt res (sa1,da1,ai)
  66
  67 primCode [res] Integer2IntOp arg@[sa,da]
  68   = gmpInteger2Int res (sa,da)
  69
  70 primCode [res] Integer2WordOp arg@[sa,da]
  71   = gmpInteger2Word res (sa,da)
  72
  73 primCode [res] Int2AddrOp [arg]
  74   = simpleCoercion AddrRep res arg
  75
  76 primCode [res] Addr2IntOp [arg]
  77   = simpleCoercion IntRep res arg
  78
  79 primCode [res] Int2WordOp [arg]
  80   = simpleCoercion IntRep{-WordRep?-} res arg
  81
  82 primCode [res] Word2IntOp [arg]
  83   = simpleCoercion IntRep res arg
  84 \end{code}
  85
  86 \begin{code}
  87 primCode [res] SameMutableArrayOp args
  88   = let
  89         compare = StPrim AddrEqOp (map amodeToStix args)
  90         assign = StAssign IntRep (amodeToStix res) compare
  91     in
  92     returnUs (\xs -> assign : xs)
  93
  94 primCode res@[_] SameMutableByteArrayOp args
  95   = primCode res SameMutableArrayOp args
  96
  97 primCode res@[_] SameMutVarOp args
  98   = primCode res SameMutableArrayOp args
  99
 100 primCode res@[_] SameMVarOp args
 101   = primCode res SameMutableArrayOp args
 102 \end{code}
 103
 104 Freezing an array of pointers is a double assignment.  We fix the
 105 header of the ``new'' closure because the lhs is probably a better
 106 addressing mode for the indirection (most likely, it's a VanillaReg).
 107
 108 \begin{code}
 109
 110 primCode [lhs] UnsafeFreezeArrayOp [rhs]
 111   = let
 112         lhs' = amodeToStix lhs
 113         rhs' = amodeToStix rhs
 114         header = StInd PtrRep lhs'
 115         assign = StAssign PtrRep lhs' rhs'
 116         freeze = StAssign PtrRep header mutArrPtrsFrozen_info
 117     in
 118     returnUs (\xs -> assign : freeze : xs)
 119
 120 primCode [lhs] UnsafeFreezeByteArrayOp [rhs]
 121   = simpleCoercion PtrRep lhs rhs
 122 \end{code}
 123
 124 Returning the size of (mutable) byte arrays is just
 125 an indexing operation.
 126
 127 \begin{code}
 128 primCode [lhs] SizeofByteArrayOp [rhs]
 129   = let
 130         lhs' = amodeToStix lhs
 131         rhs' = amodeToStix rhs
 132         sz   = StIndex IntRep rhs' fixedHS
 133         assign = StAssign IntRep lhs' (StInd IntRep sz)
 134     in
 135     returnUs (\xs -> assign : xs)
 136
 137 primCode [lhs] SizeofMutableByteArrayOp [rhs]
 138   = let
 139         lhs' = amodeToStix lhs
 140         rhs' = amodeToStix rhs
 141         sz   = StIndex IntRep rhs' fixedHS
 142         assign = StAssign IntRep lhs' (StInd IntRep sz)
 143     in
 144     returnUs (\xs -> assign : xs)
 145
 146 \end{code}
 147
 148 Most other array primitives translate to simple indexing.
 149
 150 \begin{code}
 151 primCode lhs@[_] IndexArrayOp args
 152   = primCode lhs ReadArrayOp args
 153
 154 primCode [lhs] ReadArrayOp [obj, ix]
 155   = let
 156         lhs' = amodeToStix lhs
 157         obj' = amodeToStix obj
 158         ix' = amodeToStix ix
 159         base = StIndex IntRep obj' arrPtrsHS
 160         assign = StAssign PtrRep lhs' (StInd PtrRep (StIndex PtrRep base ix'))
 161     in
 162     returnUs (\xs -> assign : xs)
 163
 164 primCode [] WriteArrayOp [obj, ix, v]
 165   = let
 166         obj' = amodeToStix obj
 167         ix' = amodeToStix ix
 168         v' = amodeToStix v
 169         base = StIndex IntRep obj' arrPtrsHS
 170         assign = StAssign PtrRep (StInd PtrRep (StIndex PtrRep base ix')) v'
 171     in
 172     returnUs (\xs -> assign : xs)
 173
 174 primCode [] WriteForeignObjOp [obj, v]
 175   = let
 176         obj' = amodeToStix obj
 177         v' = amodeToStix v
 178         obj'' = StIndex AddrRep obj' (StInt 4711) -- fixedHS
 179         assign = StAssign AddrRep (StInd AddrRep obj'') v'
 180     in
 181     returnUs (\xs -> assign : xs)
 182
 183 -- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
 184 primCode ls IndexByteArrayOp_Char      rs = primCode_ReadByteArrayOp Int8Rep      ls rs
 185 primCode ls IndexByteArrayOp_Int       rs = primCode_ReadByteArrayOp IntRep       ls rs
 186 primCode ls IndexByteArrayOp_Word      rs = primCode_ReadByteArrayOp WordRep      ls rs
 187 primCode ls IndexByteArrayOp_Addr      rs = primCode_ReadByteArrayOp AddrRep      ls rs
 188 primCode ls IndexByteArrayOp_Float     rs = primCode_ReadByteArrayOp FloatRep     ls rs
 189 primCode ls IndexByteArrayOp_Double    rs = primCode_ReadByteArrayOp DoubleRep    ls rs
 190 primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
 191 primCode ls IndexByteArrayOp_Int64     rs = primCode_ReadByteArrayOp Int64Rep     ls rs
 192 primCode ls IndexByteArrayOp_Word64    rs = primCode_ReadByteArrayOp Word64Rep    ls rs
 193
 194 primCode ls ReadByteArrayOp_Char      rs = primCode_ReadByteArrayOp Int8Rep      ls rs
 195 primCode ls ReadByteArrayOp_Int       rs = primCode_ReadByteArrayOp IntRep       ls rs
 196 primCode ls ReadByteArrayOp_Word      rs = primCode_ReadByteArrayOp WordRep      ls rs
 197 primCode ls ReadByteArrayOp_Addr      rs = primCode_ReadByteArrayOp AddrRep      ls rs
 198 primCode ls ReadByteArrayOp_Float     rs = primCode_ReadByteArrayOp FloatRep     ls rs
 199 primCode ls ReadByteArrayOp_Double    rs = primCode_ReadByteArrayOp DoubleRep    ls rs
 200 primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
 201 primCode ls ReadByteArrayOp_Int64     rs = primCode_ReadByteArrayOp Int64Rep     ls rs
 202 primCode ls ReadByteArrayOp_Word64    rs = primCode_ReadByteArrayOp Word64Rep    ls rs
 203
 204 primCode ls ReadOffAddrOp_Char      rs = primCode_IndexOffAddrOp Int8Rep      ls rs
 205 primCode ls ReadOffAddrOp_Int       rs = primCode_IndexOffAddrOp IntRep       ls rs
 206 primCode ls ReadOffAddrOp_Word      rs = primCode_IndexOffAddrOp WordRep      ls rs
 207 primCode ls ReadOffAddrOp_Addr      rs = primCode_IndexOffAddrOp AddrRep      ls rs
 208 primCode ls ReadOffAddrOp_Float     rs = primCode_IndexOffAddrOp FloatRep     ls rs
 209 primCode ls ReadOffAddrOp_Double    rs = primCode_IndexOffAddrOp DoubleRep    ls rs
 210 primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
 211 primCode ls ReadOffAddrOp_Int64     rs = primCode_IndexOffAddrOp Int64Rep     ls rs
 212 primCode ls ReadOffAddrOp_Word64    rs = primCode_IndexOffAddrOp Word64Rep    ls rs
 213
 214 primCode ls IndexOffAddrOp_Char      rs = primCode_IndexOffAddrOp Int8Rep      ls rs
 215 primCode ls IndexOffAddrOp_Int       rs = primCode_IndexOffAddrOp IntRep       ls rs
 216 primCode ls IndexOffAddrOp_Word      rs = primCode_IndexOffAddrOp WordRep      ls rs
 217 primCode ls IndexOffAddrOp_Addr      rs = primCode_IndexOffAddrOp AddrRep      ls rs
 218 primCode ls IndexOffAddrOp_Float     rs = primCode_IndexOffAddrOp FloatRep     ls rs
 219 primCode ls IndexOffAddrOp_Double    rs = primCode_IndexOffAddrOp DoubleRep    ls rs
 220 primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
 221 primCode ls IndexOffAddrOp_Int64     rs = primCode_IndexOffAddrOp Int64Rep     ls rs
 222 primCode ls IndexOffAddrOp_Word64    rs = primCode_IndexOffAddrOp Word64Rep    ls rs
 223
 224 primCode ls IndexOffForeignObjOp_Char      rs = primCode_IndexOffForeignObjOp Int8Rep      ls rs
 225 primCode ls IndexOffForeignObjOp_Int       rs = primCode_IndexOffForeignObjOp IntRep       ls rs
 226 primCode ls IndexOffForeignObjOp_Word      rs = primCode_IndexOffForeignObjOp WordRep      ls rs
 227 primCode ls IndexOffForeignObjOp_Addr      rs = primCode_IndexOffForeignObjOp AddrRep      ls rs
 228 primCode ls IndexOffForeignObjOp_Float     rs = primCode_IndexOffForeignObjOp FloatRep     ls rs
 229 primCode ls IndexOffForeignObjOp_Double    rs = primCode_IndexOffForeignObjOp DoubleRep    ls rs
 230 primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs
 231 primCode ls IndexOffForeignObjOp_Int64     rs = primCode_IndexOffForeignObjOp Int64Rep     ls rs
 232 primCode ls IndexOffForeignObjOp_Word64    rs = primCode_IndexOffForeignObjOp Word64Rep    ls rs
 233
 234 primCode ls WriteOffAddrOp_Char      rs = primCode_WriteOffAddrOp Int8Rep      ls rs
 235 primCode ls WriteOffAddrOp_Int       rs = primCode_WriteOffAddrOp IntRep       ls rs
 236 primCode ls WriteOffAddrOp_Word      rs = primCode_WriteOffAddrOp WordRep      ls rs
 237 primCode ls WriteOffAddrOp_Addr      rs = primCode_WriteOffAddrOp AddrRep      ls rs
 238 primCode ls WriteOffAddrOp_Float     rs = primCode_WriteOffAddrOp FloatRep     ls rs
 239 primCode ls WriteOffAddrOp_Double    rs = primCode_WriteOffAddrOp DoubleRep    ls rs
 240 primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs
 241 primCode ls WriteOffAddrOp_Int64     rs = primCode_WriteOffAddrOp Int64Rep     ls rs
 242 primCode ls WriteOffAddrOp_Word64    rs = primCode_WriteOffAddrOp Word64Rep    ls rs
 243
 244 primCode ls WriteByteArrayOp_Char      rs = primCode_WriteByteArrayOp Int8Rep      ls rs
 245 primCode ls WriteByteArrayOp_Int       rs = primCode_WriteByteArrayOp IntRep       ls rs
 246 primCode ls WriteByteArrayOp_Word      rs = primCode_WriteByteArrayOp WordRep      ls rs
 247 primCode ls WriteByteArrayOp_Addr      rs = primCode_WriteByteArrayOp AddrRep      ls rs
 248 primCode ls WriteByteArrayOp_Float     rs = primCode_WriteByteArrayOp FloatRep     ls rs
 249 primCode ls WriteByteArrayOp_Double    rs = primCode_WriteByteArrayOp DoubleRep    ls rs
 250 primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs
 251 primCode ls WriteByteArrayOp_Int64     rs = primCode_WriteByteArrayOp Int64Rep     ls rs
 252 primCode ls WriteByteArrayOp_Word64    rs = primCode_WriteByteArrayOp Word64Rep    ls rs
 253
 254 \end{code}
 255
 256 ToDo: saving/restoring of volatile regs around ccalls.
 257
 258 \begin{code}
 259 primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
 260   | is_asm = error "ERROR: Native code generator can't handle casm"
 261   | not may_gc = returnUs (\xs -> ccall : xs)
 262   | otherwise =
 263         save_thread_state       `thenUs` \ save ->
 264         load_thread_state       `thenUs` \ load ->
 265         getUniqueUs             `thenUs` \ uniq ->
 266         let
 267            id  = StReg (StixTemp uniq IntRep)
 268
 269            suspend = StAssign IntRep id
 270                         (StCall SLIT("suspendThread") cconv IntRep [stgBaseReg])
 271            resume  = StCall SLIT("resumeThread") cconv VoidRep [id]
 272         in
 273         returnUs (\xs -> save (suspend : ccall : resume : load xs))
 274
 275   where
 276     args = map amodeCodeForCCall rhs
 277     amodeCodeForCCall x =
 278         let base = amodeToStix' x
 279         in
 280             case getAmodeRep x of
 281               ArrayRep      -> StIndex PtrRep base arrPtrsHS
 282               ByteArrayRep  -> StIndex IntRep base arrWordsHS
 283               ForeignObjRep -> StIndex PtrRep base fixedHS
 284               _ -> base
 285
 286     ccall = case lhs of
 287       [] -> StCall fn cconv VoidRep args
 288       [lhs] ->
 289           let lhs' = amodeToStix lhs
 290               pk   = case getAmodeRep lhs of
 291                         FloatRep  -> FloatRep
 292                         DoubleRep -> DoubleRep
 293                         other     -> IntRep
 294           in
 295               StAssign pk lhs' (StCall fn cconv pk args)
 296 \end{code}
 297
 298 DataToTagOp won't work for 64-bit archs, as it is.
 299
 300 \begin{code}
 301 primCode [lhs] DataToTagOp [arg]
 302   = let lhs'        = amodeToStix lhs
 303         arg'        = amodeToStix arg
 304         infoptr     = StInd PtrRep arg'
 305         word_32     = StInd WordRep (StIndex PtrRep infoptr (StInt (-1)))
 306         masked_le32 = StPrim SrlOp [word_32, StInt 16]
 307         masked_be32 = StPrim AndOp [word_32, StInt 65535]
 308 #ifdef WORDS_BIGENDIAN
 309         masked      = masked_be32
 310 #else
 311         masked      = masked_le32
 312 #endif
 313         assign      = StAssign IntRep lhs' masked
 314     in
 315     returnUs (\xs -> assign : xs)
 316 \end{code}
 317
 318 MutVars are pretty simple.
 319 #define writeMutVarzh(a,v)       (P_)(((StgMutVar *)(a))->var)=(v)
 320
 321 \begin{code}
 322 primCode [] WriteMutVarOp [aa,vv]
 323    = let aa_s      = amodeToStix aa
 324          vv_s      = amodeToStix vv
 325          var_field = StIndex PtrRep aa_s fixedHS
 326          assign    = StAssign PtrRep (StInd PtrRep var_field) vv_s
 327      in
 328      returnUs (\xs -> assign : xs)
 329
 330 primCode [rr] ReadMutVarOp [aa]
 331    = let aa_s      = amodeToStix aa
 332          rr_s      = amodeToStix rr
 333          var_field = StIndex PtrRep aa_s fixedHS
 334          assign    = StAssign PtrRep rr_s (StInd PtrRep var_field)
 335      in
 336      returnUs (\xs -> assign : xs)
 337 \end{code}
 338
 339 Now the more mundane operations.
 340
 341 \begin{code}
 342 primCode lhs op rhs
 343   = let
 344         lhs' = map amodeToStix  lhs
 345         rhs' = map amodeToStix' rhs
 346         pk   = getAmodeRep (head lhs)
 347     in
 348     returnUs (\ xs -> simplePrim pk lhs' op rhs' : xs)
 349 \end{code}
 350
 351 Helper fns for some array ops.
 352
 353 \begin{code}
 354 primCode_ReadByteArrayOp pk [lhs] [obj, ix]
 355   = let
 356         lhs' = amodeToStix lhs
 357         obj' = amodeToStix obj
 358         ix' = amodeToStix ix
 359         base = StIndex IntRep obj' arrWordsHS
 360         assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
 361     in
 362     returnUs (\xs -> assign : xs)
 363
 364
 365 primCode_IndexOffAddrOp pk [lhs] [obj, ix]
 366   = let
 367         lhs' = amodeToStix lhs
 368         obj' = amodeToStix obj
 369         ix' = amodeToStix ix
 370         assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
 371     in
 372     returnUs (\xs -> assign : xs)
 373
 374
 375 primCode_IndexOffForeignObjOp pk [lhs] [obj, ix]
 376   = let
 377         lhs' = amodeToStix lhs
 378         obj' = amodeToStix obj
 379         ix' = amodeToStix ix
 380         obj'' = StIndex AddrRep obj' fixedHS
 381         assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
 382     in
 383     returnUs (\xs -> assign : xs)
 384
 385
 386 primCode_WriteOffAddrOp pk [] [obj, ix, v]
 387   = let
 388         obj' = amodeToStix obj
 389         ix' = amodeToStix ix
 390         v' = amodeToStix v
 391         assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
 392     in
 393     returnUs (\xs -> assign : xs)
 394
 395
 396 primCode_WriteByteArrayOp pk [] [obj, ix, v]
 397   = let
 398         obj' = amodeToStix obj
 399         ix' = amodeToStix ix
 400         v' = amodeToStix v
 401         base = StIndex IntRep obj' arrWordsHS
 402         assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
 403     in
 404     returnUs (\xs -> assign : xs)
 405
 406 \end{code}
 407
 408 \begin{code}
 409 simpleCoercion
 410       :: PrimRep
 411       -> CAddrMode
 412       -> CAddrMode
 413       -> UniqSM StixTreeList
 414
 415 simpleCoercion pk lhs rhs
 416   = returnUs (\xs -> StAssign pk (amodeToStix lhs) (amodeToStix rhs) : xs)
 417 \end{code}
 418
 419 Here we try to rewrite primitives into a form the code generator can
 420 understand.  Any primitives not handled here must be handled at the
 421 level of the specific code generator.
 422
 423 \begin{code}
 424 simplePrim
 425     :: PrimRep          -- Rep of first destination
 426     -> [StixTree]       -- Destinations
 427     -> PrimOp
 428     -> [StixTree]
 429     -> StixTree
 430 \end{code}
 431
 432 Now look for something more conventional.
 433
 434 \begin{code}
 435 simplePrim pk [lhs] op rest  = StAssign pk lhs (StPrim op rest)
 436 simplePrim pk as    op bs    = simplePrim_error op
 437
 438 simplePrim_error op
 439     = error ("ERROR: primitive operation `"++show op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
 440 \end{code}
 441
 442 %---------------------------------------------------------------------
 443
 444 Here we generate the Stix code for CAddrModes.
 445
 446 When a character is fetched from a mixed type location, we have to do
 447 an extra cast.  This is reflected in amodeCode', which is for rhs
 448 amodes that might possibly need the extra cast.
 449
 450 \begin{code}
 451 amodeToStix, amodeToStix' :: CAddrMode -> StixTree
 452
 453 amodeToStix'{-'-} am@(CVal rr CharRep)
 454     | mixedTypeLocn am = StPrim ChrOp [amodeToStix am]
 455     | otherwise = amodeToStix am
 456
 457 amodeToStix' am = amodeToStix am
 458
 459 -----------
 460 amodeToStix am@(CVal rr CharRep)
 461   | mixedTypeLocn am
 462   = StInd IntRep (amodeToStix (CAddr rr))
 463
 464 amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr))
 465
 466 amodeToStix (CAddr (SpRel off))
 467   = StIndex PtrRep stgSp (StInt (toInteger IBOX(off)))
 468
 469 amodeToStix (CAddr (HpRel off))
 470   = StIndex IntRep stgHp (StInt (toInteger (- IBOX(off))))
 471
 472 amodeToStix (CAddr (NodeRel off))
 473   = StIndex IntRep stgNode (StInt (toInteger IBOX(off)))
 474
 475 amodeToStix (CAddr (CIndex base off pk))
 476   = StIndex pk (amodeToStix base) (amodeToStix off)
 477
 478 amodeToStix (CReg magic)    = StReg (StixMagicId magic)
 479 amodeToStix (CTemp uniq pk) = StReg (StixTemp uniq pk)
 480
 481 amodeToStix (CLbl      lbl _) = StCLbl lbl
 482
 483  -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 484
 485 amodeToStix (CCharLike (CLit (MachChar c)))
 486   = StIndex Int8Rep cHARLIKE_closure (StInt (toInteger off))
 487   where
 488     off = charLikeSize * (c - mIN_CHARLIKE)
 489
 490 amodeToStix (CCharLike x)
 491   = panic "CCharLike"
 492
 493 amodeToStix (CIntLike (CLit (MachInt i)))
 494   = StIndex Int8Rep iNTLIKE_closure (StInt (toInteger off))
 495   where
 496     off = intLikeSize * (fromInteger (i - mIN_INTLIKE))
 497
 498 amodeToStix (CIntLike x)
 499   = panic "CIntLike"
 500
 501 amodeToStix (CLit core)
 502   = case core of
 503       MachChar c     -> StInt (toInteger c)
 504       MachStr s      -> StString s
 505       MachAddr a     -> StInt a
 506       MachInt i      -> StInt i
 507       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
 508       MachLitLit s _ -> litLitErr
 509       MachLabel l    -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
 510       MachFloat d    -> StFloat d
 511       MachDouble d   -> StDouble d
 512       _ -> panic "amodeToStix:core literal"
 513
 514 amodeToStix (CMacroExpr _ macro [arg])
 515   = case macro of
 516       ENTRY_CODE -> amodeToStix arg
 517       ARG_TAG    -> amodeToStix arg -- just an integer no. of words
 518       GET_TAG    ->
 519 #ifdef WORDS_BIGENDIAN
 520                     StPrim AndOp
 521                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 522                                                 (StInt (toInteger (-1)))),
 523                          StInt 65535]
 524 #else
 525                     StPrim SrlOp
 526                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 527                                                 (StInt (toInteger (-1)))),
 528                          StInt 16]
 529 #endif
 530       UPD_FRAME_UPDATEE
 531          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg)
 532                                          (StInt (toInteger uF_UPDATEE)))
 533
 534 litLitErr =
 535   panic "native code generator can't compile lit-lits, use -fvia-C"
 536 \end{code}
 537
 538 Sizes of the CharLike and IntLike closures that are arranged as arrays
 539 in the data segment.  (These are in bytes.)
 540
 541 \begin{code}
 542 -- The INTLIKE base pointer
 543
 544 iNTLIKE_closure :: StixTree
 545 iNTLIKE_closure = StCLbl mkIntlikeClosureLabel
 546
 547 -- The CHARLIKE base
 548
 549 cHARLIKE_closure :: StixTree
 550 cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
 551
 552 mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
 553
 554 -- these are the sizes of charLike and intLike closures, in _bytes_.
 555 charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 556 intLikeSize  = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 557 \end{code}
 558
 559
 560 \begin{code}
 561 save_thread_state
 562    = getUniqueUs   `thenUs` \tso_uq ->
 563      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 564      returnUs (\xs ->
 565         StAssign ThreadIdRep tso stgCurrentTSO :
 566         StAssign PtrRep
 567            (StInd PtrRep (StPrim IntAddOp
 568                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
 569            stgSp :
 570         StAssign PtrRep
 571            (StInd PtrRep (StPrim IntAddOp
 572                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
 573            stgSu :
 574         StAssign PtrRep
 575            (StInd PtrRep (StPrim IntAddOp
 576                 [stgCurrentNursery,
 577                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]))
 578            (StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) :
 579         xs
 580      )
 581
 582 load_thread_state
 583    = getUniqueUs   `thenUs` \tso_uq ->
 584      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 585      returnUs (\xs ->
 586         StAssign ThreadIdRep tso stgCurrentTSO :
 587         StAssign PtrRep stgSp
 588            (StInd PtrRep (StPrim IntAddOp
 589                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) :
 590         StAssign PtrRep stgSu
 591            (StInd PtrRep (StPrim IntAddOp
 592                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) :
 593         StAssign PtrRep stgSpLim
 594            (StPrim IntAddOp [tso,
 595                              StInt (toInteger ((TSO_STACK + rESERVED_STACK_WORDS)
 596                                                *BYTES_PER_WORD))]) :
 597         StAssign PtrRep stgHp
 598            (StPrim IntSubOp [
 599               StInd PtrRep (StPrim IntAddOp
 600                 [stgCurrentNursery,
 601                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]),
 602               StInt (toInteger (1 * BYTES_PER_WORD))
 603             ]) :
 604         StAssign PtrRep stgHpLim
 605            (StPrim IntAddOp [
 606               StInd PtrRep (StPrim IntAddOp
 607                 [stgCurrentNursery,
 608                  StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]),
 609               StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD)))
 610             ]) :
 611         xs
 612      )
 613 \end{code}