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