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