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