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 \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 JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
 259 rather than inheriting the calling convention of the thing which we're really
 260 calling.
 261
 262 \begin{code}
 263 primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
 264   | is_asm = error "ERROR: Native code generator can't handle casm"
 265   | not may_gc = returnUs (\xs -> ccall : xs)
 266   | otherwise =
 267         save_thread_state       `thenUs` \ save ->
 268         load_thread_state       `thenUs` \ load ->
 269         getUniqueUs             `thenUs` \ uniq ->
 270         let
 271            id  = StReg (StixTemp uniq IntRep)
 272
 273            suspend = StAssign IntRep id
 274                         (StCall SLIT("suspendThread") {-no:cconv-} cCallConv
 275                                 IntRep [stgBaseReg])
 276            resume  = StCall SLIT("resumeThread") {-no:cconv-} cCallConv
 277                             VoidRep [id]
 278         in
 279         returnUs (\xs -> save (suspend : ccall : resume : load xs))
 280
 281   where
 282     args = map amodeCodeForCCall rhs
 283     amodeCodeForCCall x =
 284         let base = amodeToStix' x
 285         in
 286             case getAmodeRep x of
 287               ArrayRep      -> StIndex PtrRep base arrPtrsHS
 288               ByteArrayRep  -> StIndex IntRep base arrWordsHS
 289               ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
 290               _ -> base
 291
 292     ccall = case lhs of
 293       [] -> StCall fn cconv VoidRep args
 294       [lhs] ->
 295           let lhs' = amodeToStix lhs
 296               pk   = case getAmodeRep lhs of
 297                         FloatRep  -> FloatRep
 298                         DoubleRep -> DoubleRep
 299                         other     -> IntRep
 300           in
 301               StAssign pk lhs' (StCall fn cconv pk args)
 302 \end{code}
 303
 304 DataToTagOp won't work for 64-bit archs, as it is.
 305
 306 \begin{code}
 307 primCode [lhs] DataToTagOp [arg]
 308   = let lhs'        = amodeToStix lhs
 309         arg'        = amodeToStix arg
 310         infoptr     = StInd PtrRep arg'
 311         word_32     = StInd WordRep (StIndex PtrRep infoptr (StInt (-1)))
 312         masked_le32 = StPrim SrlOp [word_32, StInt 16]
 313         masked_be32 = StPrim AndOp [word_32, StInt 65535]
 314 #ifdef WORDS_BIGENDIAN
 315         masked      = masked_be32
 316 #else
 317         masked      = masked_le32
 318 #endif
 319         assign      = StAssign IntRep lhs' masked
 320     in
 321     returnUs (\xs -> assign : xs)
 322 \end{code}
 323
 324 MutVars are pretty simple.
 325 #define writeMutVarzh(a,v)       (P_)(((StgMutVar *)(a))->var)=(v)
 326
 327 \begin{code}
 328 primCode [] WriteMutVarOp [aa,vv]
 329    = let aa_s      = amodeToStix aa
 330          vv_s      = amodeToStix vv
 331          var_field = StIndex PtrRep aa_s fixedHS
 332          assign    = StAssign PtrRep (StInd PtrRep var_field) vv_s
 333      in
 334      returnUs (\xs -> assign : xs)
 335
 336 primCode [rr] ReadMutVarOp [aa]
 337    = let aa_s      = amodeToStix aa
 338          rr_s      = amodeToStix rr
 339          var_field = StIndex PtrRep aa_s fixedHS
 340          assign    = StAssign PtrRep rr_s (StInd PtrRep var_field)
 341      in
 342      returnUs (\xs -> assign : xs)
 343 \end{code}
 344
 345 ForeignObj# primops.
 346
 347 \begin{code}
 348 primCode [rr] ForeignObjToAddrOp [fo]
 349   = let code =  StAssign AddrRep (amodeToStix rr)
 350                    (StInd AddrRep
 351                         (StIndex PtrRep (amodeToStix fo) fixedHS))
 352     in
 353     returnUs (\xs -> code : xs)
 354
 355 primCode [] TouchOp [_] = returnUs id
 356 \end{code}
 357
 358 Now the more mundane operations.
 359
 360 \begin{code}
 361 primCode lhs op rhs
 362   = let
 363         lhs' = map amodeToStix  lhs
 364         rhs' = map amodeToStix' rhs
 365         pk   = getAmodeRep (head lhs)
 366     in
 367     returnUs (\ xs -> simplePrim pk lhs' op rhs' : xs)
 368 \end{code}
 369
 370 Helper fns for some array ops.
 371
 372 \begin{code}
 373 primCode_ReadByteArrayOp pk [lhs] [obj, ix]
 374   = let
 375         lhs' = amodeToStix lhs
 376         obj' = amodeToStix obj
 377         ix' = amodeToStix ix
 378         base = StIndex IntRep obj' arrWordsHS
 379         assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
 380     in
 381     returnUs (\xs -> assign : xs)
 382
 383
 384 primCode_IndexOffAddrOp pk [lhs] [obj, ix]
 385   = let
 386         lhs' = amodeToStix lhs
 387         obj' = amodeToStix obj
 388         ix' = amodeToStix ix
 389         assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
 390     in
 391     returnUs (\xs -> assign : xs)
 392
 393
 394 primCode_IndexOffForeignObjOp pk [lhs] [obj, ix]
 395   = let
 396         lhs' = amodeToStix lhs
 397         obj' = amodeToStix obj
 398         ix' = amodeToStix ix
 399         obj'' = StIndex AddrRep obj' fixedHS
 400         assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
 401     in
 402     returnUs (\xs -> assign : xs)
 403
 404
 405 primCode_WriteOffAddrOp pk [] [obj, ix, v]
 406   = let
 407         obj' = amodeToStix obj
 408         ix' = amodeToStix ix
 409         v' = amodeToStix v
 410         assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
 411     in
 412     returnUs (\xs -> assign : xs)
 413
 414
 415 primCode_WriteByteArrayOp pk [] [obj, ix, v]
 416   = let
 417         obj' = amodeToStix obj
 418         ix' = amodeToStix ix
 419         v' = amodeToStix v
 420         base = StIndex IntRep obj' arrWordsHS
 421         assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
 422     in
 423     returnUs (\xs -> assign : xs)
 424
 425 \end{code}
 426
 427 \begin{code}
 428 simpleCoercion
 429       :: PrimRep
 430       -> CAddrMode
 431       -> CAddrMode
 432       -> UniqSM StixTreeList
 433
 434 simpleCoercion pk lhs rhs
 435   = returnUs (\xs -> StAssign pk (amodeToStix lhs) (amodeToStix rhs) : xs)
 436 \end{code}
 437
 438 Here we try to rewrite primitives into a form the code generator can
 439 understand.  Any primitives not handled here must be handled at the
 440 level of the specific code generator.
 441
 442 \begin{code}
 443 simplePrim
 444     :: PrimRep          -- Rep of first destination
 445     -> [StixTree]       -- Destinations
 446     -> PrimOp
 447     -> [StixTree]
 448     -> StixTree
 449 \end{code}
 450
 451 Now look for something more conventional.
 452
 453 \begin{code}
 454 simplePrim pk [lhs] op rest  = StAssign pk lhs (StPrim op rest)
 455 simplePrim pk as    op bs    = simplePrim_error op
 456
 457 simplePrim_error op
 458     = 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")
 459 \end{code}
 460
 461 %---------------------------------------------------------------------
 462
 463 Here we generate the Stix code for CAddrModes.
 464
 465 When a character is fetched from a mixed type location, we have to do
 466 an extra cast.  This is reflected in amodeCode', which is for rhs
 467 amodes that might possibly need the extra cast.
 468
 469 \begin{code}
 470 amodeToStix, amodeToStix' :: CAddrMode -> StixTree
 471
 472 amodeToStix'{-'-} am@(CVal rr CharRep)
 473     | mixedTypeLocn am = StPrim ChrOp [amodeToStix am]
 474     | otherwise = amodeToStix am
 475
 476 amodeToStix' am = amodeToStix am
 477
 478 -----------
 479 amodeToStix am@(CVal rr CharRep)
 480   | mixedTypeLocn am
 481   = StInd IntRep (amodeToStix (CAddr rr))
 482
 483 amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr))
 484
 485 amodeToStix (CAddr (SpRel off))
 486   = StIndex PtrRep stgSp (StInt (toInteger (iBox off)))
 487
 488 amodeToStix (CAddr (HpRel off))
 489   = StIndex IntRep stgHp (StInt (toInteger (- (iBox off))))
 490
 491 amodeToStix (CAddr (NodeRel off))
 492   = StIndex IntRep stgNode (StInt (toInteger (iBox off)))
 493
 494 amodeToStix (CAddr (CIndex base off pk))
 495   = StIndex pk (amodeToStix base) (amodeToStix off)
 496
 497 amodeToStix (CReg magic)    = StReg (StixMagicId magic)
 498 amodeToStix (CTemp uniq pk) = StReg (StixTemp uniq pk)
 499
 500 amodeToStix (CLbl      lbl _) = StCLbl lbl
 501
 502  -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 503
 504 amodeToStix (CCharLike (CLit (MachChar c)))
 505   = StIndex Int8Rep cHARLIKE_closure (StInt (toInteger off))
 506   where
 507     off = charLikeSize * (c - mIN_CHARLIKE)
 508
 509 amodeToStix (CCharLike x)
 510   = panic "CCharLike"
 511
 512 amodeToStix (CIntLike (CLit (MachInt i)))
 513   = StIndex Int8Rep iNTLIKE_closure (StInt (toInteger off))
 514   where
 515     off = intLikeSize * (fromInteger (i - mIN_INTLIKE))
 516
 517 amodeToStix (CIntLike x)
 518   = panic "CIntLike"
 519
 520 amodeToStix (CLit core)
 521   = case core of
 522       MachChar c     -> StInt (toInteger c)
 523       MachStr s      -> StString s
 524       MachAddr a     -> StInt a
 525       MachInt i      -> StInt i
 526       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
 527       MachLitLit s _ -> litLitErr
 528       MachLabel l    -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
 529       MachFloat d    -> StFloat d
 530       MachDouble d   -> StDouble d
 531       _ -> panic "amodeToStix:core literal"
 532
 533 amodeToStix (CMacroExpr _ macro [arg])
 534   = case macro of
 535       ENTRY_CODE -> amodeToStix arg
 536       ARG_TAG    -> amodeToStix arg -- just an integer no. of words
 537       GET_TAG    ->
 538 #ifdef WORDS_BIGENDIAN
 539                     StPrim AndOp
 540                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 541                                                 (StInt (toInteger (-1)))),
 542                          StInt 65535]
 543 #else
 544                     StPrim SrlOp
 545                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 546                                                 (StInt (toInteger (-1)))),
 547                          StInt 16]
 548 #endif
 549       UPD_FRAME_UPDATEE
 550          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg)
 551                                          (StInt (toInteger uF_UPDATEE)))
 552
 553 litLitErr =
 554   panic "native code generator can't compile lit-lits, use -fvia-C"
 555 \end{code}
 556
 557 Sizes of the CharLike and IntLike closures that are arranged as arrays
 558 in the data segment.  (These are in bytes.)
 559
 560 \begin{code}
 561 -- The INTLIKE base pointer
 562
 563 iNTLIKE_closure :: StixTree
 564 iNTLIKE_closure = StCLbl mkIntlikeClosureLabel
 565
 566 -- The CHARLIKE base
 567
 568 cHARLIKE_closure :: StixTree
 569 cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
 570
 571 mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
 572
 573 -- these are the sizes of charLike and intLike closures, in _bytes_.
 574 charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 575 intLikeSize  = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 576 \end{code}
 577
 578
 579 \begin{code}
 580 save_thread_state
 581    = getUniqueUs   `thenUs` \tso_uq ->
 582      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 583      returnUs (\xs ->
 584         StAssign ThreadIdRep tso stgCurrentTSO :
 585         StAssign PtrRep
 586            (StInd PtrRep (StPrim IntAddOp
 587                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
 588            stgSp :
 589         StAssign PtrRep
 590            (StInd PtrRep (StPrim IntAddOp
 591                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
 592            stgSu :
 593         StAssign PtrRep
 594            (StInd PtrRep (StPrim IntAddOp
 595                 [stgCurrentNursery,
 596                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]))
 597            (StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) :
 598         xs
 599      )
 600
 601 load_thread_state
 602    = getUniqueUs   `thenUs` \tso_uq ->
 603      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 604      returnUs (\xs ->
 605         StAssign ThreadIdRep tso stgCurrentTSO :
 606         StAssign PtrRep stgSp
 607            (StInd PtrRep (StPrim IntAddOp
 608                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) :
 609         StAssign PtrRep stgSu
 610            (StInd PtrRep (StPrim IntAddOp
 611                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) :
 612         StAssign PtrRep stgSpLim
 613            (StPrim IntAddOp [tso,
 614                              StInt (toInteger ((TSO_STACK + rESERVED_STACK_WORDS)
 615                                                *BYTES_PER_WORD))]) :
 616         StAssign PtrRep stgHp
 617            (StPrim IntSubOp [
 618               StInd PtrRep (StPrim IntAddOp
 619                 [stgCurrentNursery,
 620                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]),
 621               StInt (toInteger (1 * BYTES_PER_WORD))
 622             ]) :
 623         StAssign PtrRep stgHpLim
 624            (StPrim IntAddOp [
 625               StInd PtrRep (StPrim IntAddOp
 626                 [stgCurrentNursery,
 627                  StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]),
 628               StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD)))
 629             ]) :
 630         xs
 631      )
 632 \end{code}