ghc/compiler/nativeGen/StixPrim.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
   7
   8 #include "HsVersions.h"
   9
  10 import MachMisc
  11 import Stix
  12 import StixInteger
  13
  14 import AbsCSyn          hiding ( spRel )
  15 import AbsCUtils        ( getAmodeRep, mixedTypeLocn )
  16 import SMRep            ( fixedHdrSize )
  17 import Literal          ( Literal(..), word2IntLit )
  18 import PrimOp           ( PrimOp(..), CCall(..), CCallTarget(..) )
  19 import PrimRep          ( PrimRep(..), isFloatingRep )
  20 import UniqSupply       ( returnUs, thenUs, getUniqueUs, UniqSM )
  21 import Constants        ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
  22                           rESERVED_STACK_WORDS )
  23 import CLabel           ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
  24                           mkMAP_FROZEN_infoLabel, mkForeignLabel )
  25 import Outputable
  26 import FastTypes
  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 Int8Rep      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 Int8Rep      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 Int8Rep      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 Int8Rep      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 Int8Rep      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 Int8Rep      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 Int8Rep      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 -> StInd PtrRep (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 ForeignObj# primops.
 339
 340 \begin{code}
 341 primCode [rr] ForeignObjToAddrOp [fo]
 342   = let code =  StAssign AddrRep (amodeToStix rr)
 343                    (StInd AddrRep
 344                         (StIndex PtrRep (amodeToStix fo) fixedHS))
 345     in
 346     returnUs (\xs -> code : xs)
 347
 348 primCode [] TouchOp [_] = returnUs id
 349 \end{code}
 350
 351 Now the more mundane operations.
 352
 353 \begin{code}
 354 primCode lhs op rhs
 355   = let
 356         lhs' = map amodeToStix  lhs
 357         rhs' = map amodeToStix' rhs
 358         pk   = getAmodeRep (head lhs)
 359     in
 360     returnUs (\ xs -> simplePrim pk lhs' op rhs' : xs)
 361 \end{code}
 362
 363 Helper fns for some array ops.
 364
 365 \begin{code}
 366 primCode_ReadByteArrayOp pk [lhs] [obj, ix]
 367   = let
 368         lhs' = amodeToStix lhs
 369         obj' = amodeToStix obj
 370         ix' = amodeToStix ix
 371         base = StIndex IntRep obj' arrWordsHS
 372         assign = StAssign pk lhs' (StInd pk (StIndex pk base ix'))
 373     in
 374     returnUs (\xs -> assign : xs)
 375
 376
 377 primCode_IndexOffAddrOp pk [lhs] [obj, ix]
 378   = let
 379         lhs' = amodeToStix lhs
 380         obj' = amodeToStix obj
 381         ix' = amodeToStix ix
 382         assign = StAssign pk lhs' (StInd pk (StIndex pk obj' ix'))
 383     in
 384     returnUs (\xs -> assign : xs)
 385
 386
 387 primCode_IndexOffForeignObjOp pk [lhs] [obj, ix]
 388   = let
 389         lhs' = amodeToStix lhs
 390         obj' = amodeToStix obj
 391         ix' = amodeToStix ix
 392         obj'' = StIndex AddrRep obj' fixedHS
 393         assign = StAssign pk lhs' (StInd pk (StIndex pk obj'' ix'))
 394     in
 395     returnUs (\xs -> assign : xs)
 396
 397
 398 primCode_WriteOffAddrOp pk [] [obj, ix, v]
 399   = let
 400         obj' = amodeToStix obj
 401         ix' = amodeToStix ix
 402         v' = amodeToStix v
 403         assign = StAssign pk (StInd pk (StIndex pk obj' ix')) v'
 404     in
 405     returnUs (\xs -> assign : xs)
 406
 407
 408 primCode_WriteByteArrayOp pk [] [obj, ix, v]
 409   = let
 410         obj' = amodeToStix obj
 411         ix' = amodeToStix ix
 412         v' = amodeToStix v
 413         base = StIndex IntRep obj' arrWordsHS
 414         assign = StAssign pk (StInd pk (StIndex pk base ix')) v'
 415     in
 416     returnUs (\xs -> assign : xs)
 417
 418 \end{code}
 419
 420 \begin{code}
 421 simpleCoercion
 422       :: PrimRep
 423       -> CAddrMode
 424       -> CAddrMode
 425       -> UniqSM StixTreeList
 426
 427 simpleCoercion pk lhs rhs
 428   = returnUs (\xs -> StAssign pk (amodeToStix lhs) (amodeToStix rhs) : xs)
 429 \end{code}
 430
 431 Here we try to rewrite primitives into a form the code generator can
 432 understand.  Any primitives not handled here must be handled at the
 433 level of the specific code generator.
 434
 435 \begin{code}
 436 simplePrim
 437     :: PrimRep          -- Rep of first destination
 438     -> [StixTree]       -- Destinations
 439     -> PrimOp
 440     -> [StixTree]
 441     -> StixTree
 442 \end{code}
 443
 444 Now look for something more conventional.
 445
 446 \begin{code}
 447 simplePrim pk [lhs] op rest  = StAssign pk lhs (StPrim op rest)
 448 simplePrim pk as    op bs    = simplePrim_error op
 449
 450 simplePrim_error op
 451     = 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")
 452 \end{code}
 453
 454 %---------------------------------------------------------------------
 455
 456 Here we generate the Stix code for CAddrModes.
 457
 458 When a character is fetched from a mixed type location, we have to do
 459 an extra cast.  This is reflected in amodeCode', which is for rhs
 460 amodes that might possibly need the extra cast.
 461
 462 \begin{code}
 463 amodeToStix, amodeToStix' :: CAddrMode -> StixTree
 464
 465 amodeToStix'{-'-} am@(CVal rr CharRep)
 466     | mixedTypeLocn am = StPrim ChrOp [amodeToStix am]
 467     | otherwise = amodeToStix am
 468
 469 amodeToStix' am = amodeToStix am
 470
 471 -----------
 472 amodeToStix am@(CVal rr CharRep)
 473   | mixedTypeLocn am
 474   = StInd IntRep (amodeToStix (CAddr rr))
 475
 476 amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr))
 477
 478 amodeToStix (CAddr (SpRel off))
 479   = StIndex PtrRep stgSp (StInt (toInteger (iBox off)))
 480
 481 amodeToStix (CAddr (HpRel off))
 482   = StIndex IntRep stgHp (StInt (toInteger (- (iBox off))))
 483
 484 amodeToStix (CAddr (NodeRel off))
 485   = StIndex IntRep stgNode (StInt (toInteger (iBox off)))
 486
 487 amodeToStix (CAddr (CIndex base off pk))
 488   = StIndex pk (amodeToStix base) (amodeToStix off)
 489
 490 amodeToStix (CReg magic)    = StReg (StixMagicId magic)
 491 amodeToStix (CTemp uniq pk) = StReg (StixTemp uniq pk)
 492
 493 amodeToStix (CLbl      lbl _) = StCLbl lbl
 494
 495  -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 496
 497 amodeToStix (CCharLike (CLit (MachChar c)))
 498   = StIndex Int8Rep cHARLIKE_closure (StInt (toInteger off))
 499   where
 500     off = charLikeSize * (c - mIN_CHARLIKE)
 501
 502 amodeToStix (CCharLike x)
 503   = panic "CCharLike"
 504
 505 amodeToStix (CIntLike (CLit (MachInt i)))
 506   = StIndex Int8Rep iNTLIKE_closure (StInt (toInteger off))
 507   where
 508     off = intLikeSize * (fromInteger (i - mIN_INTLIKE))
 509
 510 amodeToStix (CIntLike x)
 511   = panic "CIntLike"
 512
 513 amodeToStix (CLit core)
 514   = case core of
 515       MachChar c     -> StInt (toInteger c)
 516       MachStr s      -> StString s
 517       MachAddr a     -> StInt a
 518       MachInt i      -> StInt i
 519       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
 520       MachLitLit s _ -> litLitErr
 521       MachLabel l    -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
 522       MachFloat d    -> StFloat d
 523       MachDouble d   -> StDouble d
 524       _ -> panic "amodeToStix:core literal"
 525
 526 amodeToStix (CMacroExpr _ macro [arg])
 527   = case macro of
 528       ENTRY_CODE -> amodeToStix arg
 529       ARG_TAG    -> amodeToStix arg -- just an integer no. of words
 530       GET_TAG    ->
 531 #ifdef WORDS_BIGENDIAN
 532                     StPrim AndOp
 533                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 534                                                 (StInt (toInteger (-1)))),
 535                          StInt 65535]
 536 #else
 537                     StPrim SrlOp
 538                         [StInd WordRep (StIndex PtrRep (amodeToStix arg)
 539                                                 (StInt (toInteger (-1)))),
 540                          StInt 16]
 541 #endif
 542       UPD_FRAME_UPDATEE
 543          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg)
 544                                          (StInt (toInteger uF_UPDATEE)))
 545
 546 litLitErr =
 547   panic "native code generator can't compile lit-lits, use -fvia-C"
 548 \end{code}
 549
 550 Sizes of the CharLike and IntLike closures that are arranged as arrays
 551 in the data segment.  (These are in bytes.)
 552
 553 \begin{code}
 554 -- The INTLIKE base pointer
 555
 556 iNTLIKE_closure :: StixTree
 557 iNTLIKE_closure = StCLbl mkIntlikeClosureLabel
 558
 559 -- The CHARLIKE base
 560
 561 cHARLIKE_closure :: StixTree
 562 cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
 563
 564 mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
 565
 566 -- these are the sizes of charLike and intLike closures, in _bytes_.
 567 charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 568 intLikeSize  = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
 569 \end{code}
 570
 571
 572 \begin{code}
 573 save_thread_state
 574    = getUniqueUs   `thenUs` \tso_uq ->
 575      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 576      returnUs (\xs ->
 577         StAssign ThreadIdRep tso stgCurrentTSO :
 578         StAssign PtrRep
 579            (StInd PtrRep (StPrim IntAddOp
 580                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
 581            stgSp :
 582         StAssign PtrRep
 583            (StInd PtrRep (StPrim IntAddOp
 584                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
 585            stgSu :
 586         StAssign PtrRep
 587            (StInd PtrRep (StPrim IntAddOp
 588                 [stgCurrentNursery,
 589                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]))
 590            (StPrim IntAddOp [stgHp, StInt (toInteger (1 * BYTES_PER_WORD))]) :
 591         xs
 592      )
 593
 594 load_thread_state
 595    = getUniqueUs   `thenUs` \tso_uq ->
 596      let tso = StReg (StixTemp tso_uq ThreadIdRep) in
 597      returnUs (\xs ->
 598         StAssign ThreadIdRep tso stgCurrentTSO :
 599         StAssign PtrRep stgSp
 600            (StInd PtrRep (StPrim IntAddOp
 601                 [tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])) :
 602         StAssign PtrRep stgSu
 603            (StInd PtrRep (StPrim IntAddOp
 604                 [tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])) :
 605         StAssign PtrRep stgSpLim
 606            (StPrim IntAddOp [tso,
 607                              StInt (toInteger ((TSO_STACK + rESERVED_STACK_WORDS)
 608                                                *BYTES_PER_WORD))]) :
 609         StAssign PtrRep stgHp
 610            (StPrim IntSubOp [
 611               StInd PtrRep (StPrim IntAddOp
 612                 [stgCurrentNursery,
 613                  StInt (toInteger (BDESCR_FREE * BYTES_PER_WORD))]),
 614               StInt (toInteger (1 * BYTES_PER_WORD))
 615             ]) :
 616         StAssign PtrRep stgHpLim
 617            (StPrim IntAddOp [
 618               StInd PtrRep (StPrim IntAddOp
 619                 [stgCurrentNursery,
 620                  StInt (toInteger (BDESCR_START * BYTES_PER_WORD))]),
 621               StInt (toInteger (bLOCK_SIZE - (1 * BYTES_PER_WORD)))
 622             ]) :
 623         xs
 624      )
 625 \end{code}