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