ghc/compiler/nativeGen/StixPrim.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \begin{code}
   6 #include "HsVersions.h"
   7
   8 module StixPrim (
   9         genPrimCode, amodeCode, amodeCode',
  10
  11         Target, CAddrMode, StixTree, PrimOp, SplitUniqSupply
  12     ) where
  13
  14 IMPORT_Trace    -- ToDo: rm debugging
  15
  16 import AbsCSyn
  17 import AbsPrel          ( PrimOp(..), PrimOpResultInfo(..), TyCon,
  18                           getPrimOpResultInfo, isCompareOp, showPrimOp
  19                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  20                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  21                         )
  22 import AbsUniType       ( cmpTyCon ) -- pragmas only
  23 import CgCompInfo       ( spARelToInt, spBRelToInt )
  24 import MachDesc
  25 import Pretty
  26 import PrimKind         ( isFloatingKind )
  27 import CostCentre
  28 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  29 import Stix
  30 import StixMacro        ( smStablePtrTable )
  31 import StixInteger      {- everything -}
  32 import SplitUniq
  33 import Unique
  34 import Unpretty
  35 import Util
  36
  37 \end{code}
  38
  39 The main honcho here is genPrimCode, which handles the guts of COpStmts.
  40
  41 \begin{code}
  42 arrayOfData_info      = sStLitLbl SLIT("ArrayOfData_info") -- out here to avoid CAF (sigh)
  43 imMutArrayOfPtrs_info = sStLitLbl SLIT("ImMutArrayOfPtrs_info")
  44
  45 genPrimCode
  46     :: Target
  47     -> [CAddrMode]      -- results
  48     -> PrimOp           -- op
  49     -> [CAddrMode]      -- args
  50     -> SUniqSM StixTreeList
  51
  52 \end{code}
  53
  54 First, the dreaded @ccall@.  We can't handle @casm@s.
  55
  56 Usually, this compiles to an assignment, but when the left-hand side is
  57 empty, we just perform the call and ignore the result.
  58
  59 ToDo ADR: modify this to handle Malloc Ptrs.
  60
  61 btw Why not let programmer use casm to provide assembly code instead
  62 of C code?  ADR
  63
  64 \begin{code}
  65
  66 genPrimCode target lhs (CCallOp fn is_asm may_gc arg_tys result_ty) rhs
  67   | is_asm = error "ERROR: Native code generator can't handle casm"
  68   | otherwise =
  69     case lhs of
  70         [] -> returnSUs (\xs -> (StCall fn VoidKind args) : xs)
  71         [lhs] ->
  72             let lhs' = amodeToStix target lhs
  73                 pk = if isFloatingKind (getAmodeKind lhs) then DoubleKind else IntKind
  74                 call = StAssign pk lhs' (StCall fn pk args)
  75             in
  76                 returnSUs (\xs -> call : xs)
  77     where
  78         args = map amodeCodeForCCall rhs
  79         amodeCodeForCCall x =
  80             let base = amodeToStix' target x
  81             in
  82                 case getAmodeKind x of
  83                     ArrayKind -> StIndex PtrKind base (mutHS target)
  84                     ByteArrayKind -> StIndex IntKind base (dataHS target)
  85                     MallocPtrKind -> error "ERROR: native-code generator can't handle Malloc Ptrs (yet): use -fvia-C!"
  86                     _ -> base
  87
  88 \end{code}
  89
  90 The @ErrorIO@ primitive is actually a bit weird...assign a new value to the root
  91 closure, flush stdout and stderr, and jump to the @ErrorIO_innards@.
  92
  93 \begin{code}
  94
  95 genPrimCode target [] ErrorIOPrimOp [rhs] =
  96     let changeTop = StAssign PtrKind topClosure (amodeToStix target rhs)
  97     in
  98         returnSUs (\xs -> changeTop : flushStdout : flushStderr : errorIO : xs)
  99
 100 \end{code}
 101
 102 The (MP) integer operations are a true nightmare.  Since we don't have a
 103 convenient abstract way of allocating temporary variables on the (C) stack,
 104 we use the space just below HpLim for the @MP_INT@ structures, and modify our
 105 heap check accordingly.
 106
 107 \begin{code}
 108
 109 genPrimCode target res IntegerAddOp args =
 110     gmpTake2Return1 target res SLIT("mpz_add") args
 111 genPrimCode target res IntegerSubOp args =
 112     gmpTake2Return1 target res SLIT("mpz_sub") args
 113 genPrimCode target res IntegerMulOp args =
 114     gmpTake2Return1 target res SLIT("mpz_mul") args
 115
 116 genPrimCode target res IntegerNegOp arg =
 117     gmpTake1Return1 target res SLIT("mpz_neg") arg
 118
 119 genPrimCode target res IntegerQuotRemOp arg =
 120     gmpTake2Return2 target res SLIT("mpz_divmod") arg
 121 genPrimCode target res IntegerDivModOp arg =
 122     gmpTake2Return2 target res SLIT("mpz_targetivmod") arg
 123
 124 \end{code}
 125
 126 Since we are using the heap for intermediate @MP_INT@ structs, integer comparison
 127 {\em does} require a heap check in the native code implementation.
 128
 129 \begin{code}
 130
 131 genPrimCode target [res] IntegerCmpOp args = gmpCompare target res args
 132
 133 genPrimCode target [res] Integer2IntOp arg = gmpInteger2Int target res arg
 134
 135 genPrimCode target res Int2IntegerOp args = gmpInt2Integer target res args
 136
 137 genPrimCode target res Word2IntegerOp args = panic "genPrimCode:Word2IntegerOp"
 138
 139 genPrimCode target res Addr2IntegerOp args = gmpString2Integer target res args
 140
 141 genPrimCode target res FloatEncodeOp args =
 142     encodeFloatingKind FloatKind target res args
 143
 144 genPrimCode target res DoubleEncodeOp args =
 145     encodeFloatingKind DoubleKind target res args
 146
 147 genPrimCode target res FloatDecodeOp args =
 148     decodeFloatingKind FloatKind target res args
 149
 150 genPrimCode target res DoubleDecodeOp args =
 151     decodeFloatingKind DoubleKind target res args
 152
 153 genPrimCode target res Int2AddrOp arg =
 154     simpleCoercion target AddrKind res arg
 155
 156 genPrimCode target res Addr2IntOp arg =
 157     simpleCoercion target IntKind res arg
 158
 159 genPrimCode target res Int2WordOp arg =
 160     simpleCoercion target IntKind{-WordKind?-} res arg
 161
 162 genPrimCode target res Word2IntOp arg =
 163     simpleCoercion target IntKind res arg
 164
 165 \end{code}
 166
 167 @newArray#@ ops allocate heap space.
 168
 169 \begin{code}
 170
 171 genPrimCode target [res] NewArrayOp args =
 172     let [liveness, n, initial] = map (amodeToStix target) args
 173         result = amodeToStix target res
 174         space = StPrim IntAddOp [n, mutHS target]
 175         loc = StIndex PtrKind stgHp
 176               (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
 177         assign = StAssign PtrKind result loc
 178         initialise = StCall SLIT("newArrZh_init") VoidKind [result, n, initial]
 179     in
 180         heapCheck target liveness space (StInt 0)
 181                                                         `thenSUs` \ heap_chk ->
 182
 183         returnSUs (heap_chk . (\xs -> assign : initialise : xs))
 184
 185 genPrimCode target [res] (NewByteArrayOp pk) args =
 186     let [liveness, count] = map (amodeToStix target) args
 187         result = amodeToStix target res
 188         n = StPrim IntMulOp [count, StInt (toInteger (sizeof target pk))]
 189         slop = StPrim IntAddOp [n, StInt (toInteger (sizeof target IntKind - 1))]
 190         words = StPrim IntDivOp [slop, StInt (toInteger (sizeof target IntKind))]
 191         space = StPrim IntAddOp [n, StPrim IntAddOp [words, dataHS target]]
 192         loc = StIndex PtrKind stgHp
 193               (StPrim IntNegOp [StPrim IntSubOp [space, StInt 1]])
 194         assign = StAssign PtrKind result loc
 195         init1 = StAssign PtrKind (StInd PtrKind loc) arrayOfData_info
 196         init2 = StAssign IntKind
 197                          (StInd IntKind
 198                                 (StIndex IntKind loc
 199                                          (StInt (toInteger (fixedHeaderSize target)))))
 200                          (StPrim IntAddOp [words,
 201                                           StInt (toInteger (varHeaderSize target
 202                                                                           (DataRep 0)))])
 203     in
 204         heapCheck target liveness space (StInt 0)
 205                                                         `thenSUs` \ heap_chk ->
 206
 207         returnSUs (heap_chk . (\xs -> assign : init1 : init2 : xs))
 208
 209 genPrimCode target [res] SameMutableArrayOp args =
 210     let compare = StPrim AddrEqOp (map (amodeToStix target) args)
 211         assign = StAssign IntKind (amodeToStix target res) compare
 212     in
 213         returnSUs (\xs -> assign : xs)
 214
 215 genPrimCode target res SameMutableByteArrayOp args =
 216     genPrimCode target res SameMutableArrayOp args
 217
 218 \end{code}
 219
 220 Freezing an array of pointers is a double assignment.  We fix the header of
 221 the ``new'' closure because the lhs is probably a better addressing mode for
 222 the indirection (most likely, it's a VanillaReg).
 223
 224 \begin{code}
 225
 226 genPrimCode target [lhs] UnsafeFreezeArrayOp [rhs] =
 227     let lhs' = amodeToStix target lhs
 228         rhs' = amodeToStix target rhs
 229         header = StInd PtrKind lhs'
 230         assign = StAssign PtrKind lhs' rhs'
 231         freeze = StAssign PtrKind header imMutArrayOfPtrs_info
 232     in
 233         returnSUs (\xs -> assign : freeze : xs)
 234
 235 genPrimCode target lhs UnsafeFreezeByteArrayOp rhs =
 236     simpleCoercion target PtrKind lhs rhs
 237
 238 \end{code}
 239
 240 Most other array primitives translate to simple indexing.
 241
 242 \begin{code}
 243
 244 genPrimCode target lhs IndexArrayOp args =
 245     genPrimCode target lhs ReadArrayOp args
 246
 247 genPrimCode target [lhs] ReadArrayOp [obj, ix] =
 248     let lhs' = amodeToStix target lhs
 249         obj' = amodeToStix target obj
 250         ix' = amodeToStix target ix
 251         base = StIndex IntKind obj' (mutHS target)
 252         assign = StAssign PtrKind lhs' (StInd PtrKind (StIndex PtrKind base ix'))
 253     in
 254         returnSUs (\xs -> assign : xs)
 255
 256 genPrimCode target [lhs] WriteArrayOp [obj, ix, v] =
 257     let obj' = amodeToStix target obj
 258         ix' = amodeToStix target ix
 259         v' = amodeToStix target v
 260         base = StIndex IntKind obj' (mutHS target)
 261         assign = StAssign PtrKind (StInd PtrKind (StIndex PtrKind base ix')) v'
 262     in
 263         returnSUs (\xs -> assign : xs)
 264
 265 genPrimCode target lhs (IndexByteArrayOp pk) args =
 266     genPrimCode target lhs (ReadByteArrayOp pk) args
 267
 268 genPrimCode target [lhs] (ReadByteArrayOp pk) [obj, ix] =
 269     let lhs' = amodeToStix target lhs
 270         obj' = amodeToStix target obj
 271         ix' = amodeToStix target ix
 272         base = StIndex IntKind obj' (dataHS target)
 273         assign = StAssign pk lhs' (StInd pk (StIndex CharKind base ix'))
 274     in
 275         returnSUs (\xs -> assign : xs)
 276
 277 genPrimCode target [] (WriteByteArrayOp pk) [obj, ix, v] =
 278     let obj' = amodeToStix target obj
 279         ix' = amodeToStix target ix
 280         v' = amodeToStix target v
 281         base = StIndex IntKind obj' (dataHS target)
 282         assign = StAssign pk (StInd pk (StIndex CharKind base ix')) v'
 283     in
 284         returnSUs (\xs -> assign : xs)
 285
 286 genPrimCode target [lhs] (IndexOffAddrOp pk) [obj, ix] =
 287     let lhs' = amodeToStix target lhs
 288         obj' = amodeToStix target obj
 289         ix' = amodeToStix target ix
 290         assign = StAssign pk lhs' (StInd pk (StIndex CharKind obj' ix'))
 291     in
 292         returnSUs (\xs -> assign : xs)
 293
 294 \end{code}
 295
 296 Stable pointer operations.
 297
 298 First the easy one.
 299
 300 \begin{code}
 301
 302 genPrimCode target [lhs] DeRefStablePtrOp [sp] =
 303     let lhs' = amodeToStix target lhs
 304         pk = getAmodeKind lhs
 305         sp' = amodeToStix target sp
 306         call = StCall SLIT("deRefStablePointer") pk [sp', smStablePtrTable]
 307         assign = StAssign pk lhs' call
 308     in
 309         returnSUs (\xs -> assign : xs)
 310
 311 \end{code}
 312
 313 Now the hard one.  For comparison, here's the code from StgMacros:
 314
 315 \begin{verbatim}
 316 #define makeStablePtrZh(stablePtr,liveness,unstablePtr)              \
 317 do {                                                                 \
 318   EXTDATA(MK_INFO_LBL(StablePointerTable));                          \
 319   EXTDATA(UnusedSP);                                                 \
 320   StgStablePtr newSP;                                                \
 321                                                                      \
 322   if (SPT_EMPTY(StorageMgrInfo.StablePointerTable)) { /* free stack is empty */ \
 323     I_ OldNoPtrs = SPT_NoPTRS(StorageMgrInfo.StablePointerTable);    \
 324                                                                      \
 325     /* any strictly increasing expression will do here */            \
 326     I_ NewNoPtrs = OldNoPtrs * 2 + 100;                              \
 327                                                                      \
 328     I_ NewSize = DYN_VHS + NewNoPtrs + 1 + NewNoPtrs;                \
 329     P_ SPTable;                                                      \
 330                                                                      \
 331     HEAP_CHK(NO_LIVENESS, _FHS+NewSize, 0);                          \
 332     CC_ALLOC(CCC, _FHS+NewSize, SPT_K); /* cc prof */                \
 333                                                                      \
 334     SPTable = Hp + 1 - (_FHS + NewSize);                             \
 335     SET_DYN_HDR(SPTable,StablePointerTable,CCC,NewSize,NewNoPtrs);   \
 336     SAFESTGCALL2(void, (void *, P_, P_), enlargeSPTable, SPTable, StorageMgrInfo.StablePointerTable);      \
 337     StorageMgrInfo.StablePointerTable = SPTable;                     \
 338   }                                                                  \
 339                                                                      \
 340   newSP = SPT_POP(StorageMgrInfo.StablePointerTable);                \
 341   SPT_SPTR(StorageMgrInfo.StablePointerTable, newSP) = unstablePtr; \
 342   stablePtr = newSP;                                                 \
 343 } while (0)
 344 \end{verbatim}
 345
 346 ToDo ADR: finish this.  (Boy, this is hard work!)
 347
 348 Notes for ADR:
 349     trMumbles are now just StMumbles.
 350     StInt 1 is how to write ``1''
 351     temporaries are allocated at the end of the heap (see notes in StixInteger)
 352     Good luck!
 353
 354     --JSM
 355
 356 \begin{pseudocode}
 357 genPrimCode sty md [lhs] MakeStablePtrOp args =
 358     let
 359         -- some useful abbreviations (I'm sure these must exist already)
 360         add = trPrim . IntAddOp
 361         sub = trPrim . IntSubOp
 362         one = trInt [1]
 363         dec x = trAssign IntKind [x, sub [x, one]]
 364         inc x = trAssign IntKind [x, add [x, one]]
 365
 366         -- tedious hardwiring in of closure layout offsets (from SMClosures)
 367         dynHS = 2 + fixedHeaderSize md sty + varHeaderSize md sty DynamicRep
 368         spt_SIZE c   = trIndex PtrKind [c, trInt [fhs + gc_reserved] ]
 369         spt_NoPTRS c = trIndex PtrKind [c, trInt [fhs + gc_reserved + 1] ]
 370         spt_SPTR c i = trIndex PtrKind [c, add [trInt [dynHS], i]]
 371         spt_TOP c    = trIndex PtrKind [c, add [trInt [dynHS], spt_NoPTRS c]]
 372         spt_FREE c i = trIndex PtrKind [c, add [trInt [dynHS], spt_NoPTRS c]]
 373
 374         -- tedious hardwiring in of stack manipulation macros (from SMClosures)
 375         spt_FULL c lbl =
 376                 trCondJump lbl [trPrim IntEqOp [spt_TOP c, spt_NoPTRS c]]
 377         spt_EMPTY c lbl =
 378                 trCondJump lbl [trPrim IntEqOp [spt_TOP c, trInt [0]]]
 379         spt_PUSH c f = [
 380                 trAssign PtrKind [spt_FREE c (spt_TOP c), f],
 381                 inc (spt_TOP c),
 382         spt_POP c x  = [
 383                 dec (spt_TOP c),
 384                 trAssign PtrKind [x, spt_FREE c (spt_TOP c)]
 385         ]
 386
 387         -- now to get down to business
 388         lhs' = amodeCode sty md lhs
 389         [liveness, unstable] = map (amodeCode sty md) args
 390
 391         spt = smStablePtrTable
 392
 393         newSPT = -- a temporary (don't know how to allocate it)
 394         newSP = -- another temporary
 395
 396         allocNewTable = -- some sort fo heap allocation needed
 397         copyOldTable = trCall "enlargeSPTable" PtrKind [newSPT, spt]
 398
 399         enlarge =
 400                 allocNewTable ++ [
 401                 copyOldTable,
 402                 trAssign PtrKind [spt, newSPT]
 403         allocate = [
 404                 spt_POP spt newSP,
 405                 trAssign PtrKind [spt_SPTR spt newSP, unstable],
 406                 trAssign StablePtrKind [lhs', newSP]
 407         ]
 408
 409     in
 410     getUniqLabelCTS                                `thenCTS` \ oklbl ->
 411     returnCodes sty md
 412         (spt_EMPTY spt oklbl : (enlarge ++ (trLabel [oklbl] : allocate)))
 413 \end{pseudocode}
 414
 415
 416 Now the more mundane operations.
 417
 418 \begin{code}
 419
 420 genPrimCode target lhs op rhs =
 421     let lhs' = map (amodeToStix target) lhs
 422         rhs' = map (amodeToStix' target) rhs
 423     in
 424         returnSUs (\ xs -> simplePrim target lhs' op rhs' : xs)
 425
 426 simpleCoercion
 427     :: Target
 428     -> PrimKind
 429     -> [CAddrMode]
 430     -> [CAddrMode]
 431     -> SUniqSM StixTreeList
 432
 433 simpleCoercion target pk [lhs] [rhs] =
 434     returnSUs (\xs -> StAssign pk (amodeToStix target lhs) (amodeToStix target rhs) : xs)
 435
 436 \end{code}
 437
 438 Here we try to rewrite primitives into a form the code generator
 439 can understand.  Any primitives not handled here must be handled
 440 at the level of the specific code generator.
 441
 442 \begin{code}
 443
 444 simplePrim
 445     :: Target
 446     -> [StixTree]
 447     -> PrimOp
 448     -> [StixTree]
 449     -> StixTree
 450
 451 \end{code}
 452
 453 Now look for something more conventional.
 454
 455 \begin{code}
 456
 457 simplePrim target [lhs] op rest = StAssign pk lhs (StPrim op rest)
 458     where pk = if isCompareOp op then IntKind
 459                else case getPrimOpResultInfo op of
 460                  ReturnsPrim pk -> pk
 461                  _ -> simplePrim_error op
 462
 463 simplePrim target _ op _ = simplePrim_error op
 464
 465 simplePrim_error op
 466   = error ("ERROR: primitive operation `"++showPrimOp PprDebug 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")
 467 \end{code}
 468
 469 %---------------------------------------------------------------------
 470
 471 Here we generate the Stix code for CAddrModes.
 472
 473 When a character is fetched from a mixed type location, we have to
 474 do an extra cast.  This is reflected in amodeCode', which is for rhs
 475 amodes that might possibly need the extra cast.
 476
 477 \begin{code}
 478
 479 amodeCode, amodeCode'
 480     :: Target
 481     -> CAddrMode
 482     -> StixTree
 483
 484 amodeCode' target am@(CVal rr CharKind)
 485     | mixedTypeLocn am = StPrim ChrOp [amodeToStix target am]
 486     | otherwise = amodeToStix target am
 487
 488 amodeCode' target am = amodeToStix target am
 489
 490 amodeCode target am@(CVal rr CharKind) | mixedTypeLocn am =
 491         StInd IntKind (amodeCode target (CAddr rr))
 492
 493 amodeCode target (CVal rr pk) = StInd pk (amodeCode target (CAddr rr))
 494
 495 amodeCode target (CAddr r@(SpARel spA off)) =
 496     StIndex PtrKind stgSpA (StInt (toInteger (spARelToInt r)))
 497
 498 amodeCode target (CAddr r@(SpBRel spB off)) =
 499     StIndex IntKind stgSpB (StInt (toInteger (spBRelToInt r)))
 500
 501 amodeCode target (CAddr (HpRel hp off)) =
 502     StIndex IntKind stgHp (StInt (toInteger (-(hpRel target (hp `subOff` off)))))
 503
 504 amodeCode target (CAddr (NodeRel off)) =
 505     StIndex IntKind stgNode (StInt (toInteger (hpRel target off)))
 506
 507 amodeCode target (CReg magic) = StReg (StixMagicId magic)
 508 amodeCode target (CTemp uniq pk) = StReg (StixTemp uniq pk)
 509
 510 amodeCode target (CLbl lbl _) = StCLbl lbl
 511
 512 amodeCode target (CUnVecLbl dir _) = StCLbl dir
 513
 514 amodeCode target (CTableEntry base off pk) =
 515     StInd pk (StIndex pk (amodeCode target base) (amodeCode target off))
 516
 517 -- For CharLike and IntLike, we attempt some trivial constant-folding here.
 518
 519 amodeCode target (CCharLike (CLit (MachChar c))) =
 520     StLitLbl (uppBeside (uppPStr SLIT("CHARLIKE_closures+")) (uppInt off))
 521     where off = charLikeClosureSize target * ord c
 522
 523 amodeCode target (CCharLike x) =
 524     StPrim IntAddOp [charLike, off]
 525     where off = StPrim IntMulOp [amodeCode target x,
 526             StInt (toInteger (charLikeClosureSize target))]
 527
 528 amodeCode target (CIntLike (CLit (MachInt i _))) =
 529     StPrim IntAddOp [intLikePtr, StInt off]
 530     where off = toInteger (intLikeClosureSize target) * i
 531
 532 amodeCode target (CIntLike x) =
 533     StPrim IntAddOp [intLikePtr, off]
 534     where off = StPrim IntMulOp [amodeCode target x,
 535             StInt (toInteger (intLikeClosureSize target))]
 536
 537 -- A CString is just a (CLit . MachStr)
 538 amodeCode target (CString s) = StString s
 539
 540 amodeCode target (CLit core) = case core of
 541     (MachChar c) -> StInt (toInteger (ord c))
 542     (MachStr s) -> StString s
 543     (MachAddr a) -> StInt a
 544     (MachInt i _) -> StInt i
 545     (MachLitLit s _) -> StLitLit s
 546     (MachFloat d) -> StDouble d
 547     (MachDouble d) -> StDouble d
 548     _ -> panic "amodeCode:core literal"
 549
 550 -- A CLitLit is just a (CLit . MachLitLit)
 551 amodeCode target (CLitLit s _) = StLitLit s
 552
 553 -- COffsets are in words, not bytes!
 554 amodeCode target (COffset off) = StInt (toInteger (hpRel target off))
 555
 556 amodeCode target (CMacroExpr _ macro [arg]) =
 557     case macro of
 558         INFO_PTR -> StInd PtrKind (amodeToStix target arg)
 559         ENTRY_CODE -> amodeToStix target arg
 560         INFO_TAG -> tag
 561         EVAL_TAG -> StPrim IntGeOp [tag, StInt 0]
 562   where
 563     tag = StInd IntKind (StIndex IntKind (amodeToStix target arg) (StInt (-2)))
 564     -- That ``-2'' really bothers me. (JSM)
 565
 566 amodeCode target (CCostCentre cc print_as_string)
 567   = if noCostCentreAttached cc
 568     then StComment SLIT("") -- sigh
 569     else panic "amodeCode:CCostCentre"
 570 \end{code}
 571
 572 Sizes of the CharLike and IntLike closures that are arranged as arrays in the
 573 data segment.  (These are in bytes.)
 574
 575 \begin{code}
 576
 577 -- The INTLIKE base pointer
 578
 579 intLikePtr :: StixTree
 580
 581 intLikePtr = StInd PtrKind (sStLitLbl SLIT("INTLIKE_closures"))
 582
 583 -- The CHARLIKE base
 584
 585 charLike :: StixTree
 586
 587 charLike = sStLitLbl SLIT("CHARLIKE_closures")
 588
 589 -- Trees for the ErrorIOPrimOp
 590
 591 topClosure, flushStdout, flushStderr, errorIO :: StixTree
 592
 593 topClosure = StInd PtrKind (sStLitLbl SLIT("TopClosure"))
 594 flushStdout = StCall SLIT("fflush") VoidKind [StLitLit SLIT("stdout")]
 595 flushStderr = StCall SLIT("fflush") VoidKind [StLitLit SLIT("stderr")]
 596 errorIO = StJump (StInd PtrKind (sStLitLbl SLIT("ErrorIO_innards")))
 597
 598 \end{code}
 599