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