PprC.hs 40.2 KB
Newer Older
1
2
3
4
-----------------------------------------------------------------------------
--
-- Pretty-printing of Cmm as C, suitable for feeding gcc
--
Simon Marlow's avatar
Simon Marlow committed
5
-- (c) The University of Glasgow 2004-2006
6
7
8
--
-- Print Cmm as real C, for -fvia-C
--
9
10
-- See wiki:Commentary/Compiler/Backends/PprC
--
11
12
13
14
-- This is simpler than the old PprAbsC, because Cmm is "macro-expanded"
-- relative to the old AbstractC, and many oddities/decorations have
-- disappeared from the data type.
--
dterei's avatar
dterei committed
15
16
17
-- This code generator is only supported in unregisterised mode.
--
-----------------------------------------------------------------------------
Ian Lynagh's avatar
Ian Lynagh committed
18

19
20
module PprC (
        writeCs,
dterei's avatar
dterei committed
21
        pprStringInCStyle
22
23
  ) where

24
25
#include "HsVersions.h"

26
-- Cmm stuff
27
import BlockId
28
29
import CLabel
import ForeignCall
dterei's avatar
dterei committed
30
31
import OldCmm
import OldPprCmm ()
32
33

-- Utils
dterei's avatar
dterei committed
34
35
import Constants
import CPrim
Simon Marlow's avatar
Simon Marlow committed
36
import DynFlags
37
38
import FastString
import Outputable
39
import Platform
dterei's avatar
dterei committed
40
41
import UniqSet
import Unique
42
import Util
43
44

-- The rest
dterei's avatar
dterei committed
45
import Control.Monad.ST
Simon Marlow's avatar
Simon Marlow committed
46
47
import Data.Bits
import Data.Char
dterei's avatar
dterei committed
48
import Data.List
49
import Data.Map (Map)
Simon Marlow's avatar
Simon Marlow committed
50
import Data.Word
dterei's avatar
dterei committed
51
52
import System.IO
import qualified Data.Map as Map
53

54
#if __GLASGOW_HASKELL__ >= 703
dterei's avatar
dterei committed
55
56
import Data.Array.Unsafe ( castSTUArray )
import Data.Array.ST hiding ( castSTUArray )
57
#else
58
import Data.Array.ST
59
60
#endif

61
62
63
-- --------------------------------------------------------------------------
-- Top level

Simon Peyton Jones's avatar
Simon Peyton Jones committed
64
pprCs :: DynFlags -> [RawCmmGroup] -> SDoc
65
pprCs dflags cmms
66
 = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC (targetPlatform dflags) c) cmms)
67
68
 where
   split_marker
Ian Lynagh's avatar
Ian Lynagh committed
69
     | dopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER")
dterei's avatar
dterei committed
70
     | otherwise                 = empty
71

Simon Peyton Jones's avatar
Simon Peyton Jones committed
72
writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO ()
dterei's avatar
dterei committed
73
writeCs dflags handle cmms
74
  = printForC handle (pprCs dflags cmms)
75
76
77
78
79
80
81

-- --------------------------------------------------------------------------
-- Now do some real work
--
-- for fun, we could call cmmToCmm over the tops...
--

82
83
pprC :: Platform -> RawCmmGroup -> SDoc
pprC platform tops = vcat $ intersperse blankLine $ map (pprTop platform) tops
84
85
86

--
-- top level procs
dterei's avatar
dterei committed
87
--
88
89
pprTop :: Platform -> RawCmmDecl -> SDoc
pprTop platform (CmmProc mb_info clbl (ListGraph blocks)) =
90
91
    (case mb_info of
       Nothing -> empty
92
93
       Just (Statics info_clbl info_dat) -> pprDataExterns platform info_dat $$
                                            pprWordArray platform info_clbl info_dat) $$
94
    (vcat [
dterei's avatar
dterei committed
95
96
           blankLine,
           extern_decls,
97
           (if (externallyVisibleCLabel clbl)
98
                    then mkFN_ else mkIF_) (pprCLabel platform clbl) <+> lbrace,
99
100
           nest 8 temp_decls,
           nest 8 mkFB_,
101
102
103
104
           case blocks of
               [] -> empty
               -- the first block doesn't get a label:
               (BasicBlock _ stmts : rest) ->
105
106
                    nest 8 (vcat (map (pprStmt platform) stmts)) $$
                       vcat (map (pprBBlock platform) rest),
107
108
109
110
           nest 8 mkFE_,
           rbrace ]
    )
  where
111
        (temp_decls, extern_decls) = pprTempAndExternDecls platform blocks
112
113
114
115
116
117


-- Chunks of static data.

-- We only handle (a) arrays of word-sized things and (b) strings.

118
pprTop platform (CmmData _section (Statics lbl [CmmString str])) =
119
  hcat [
120
    pprLocalness lbl, ptext (sLit "char "), pprCLabel platform lbl,
Ian Lynagh's avatar
Ian Lynagh committed
121
    ptext (sLit "[] = "), pprStringInCStyle str, semi
122
123
  ]

124
pprTop platform (CmmData _section (Statics lbl [CmmUninitialised size])) =
125
  hcat [
126
    pprLocalness lbl, ptext (sLit "char "), pprCLabel platform lbl,
127
128
129
    brackets (int size), semi
  ]

130
131
132
pprTop platform (CmmData _section (Statics lbl lits)) =
  pprDataExterns platform lits $$
  pprWordArray platform lbl lits
133
134
135
136
137
138
139
140

-- --------------------------------------------------------------------------
-- BasicBlocks are self-contained entities: they always end in a jump.
--
-- Like nativeGen/AsmCodeGen, we could probably reorder blocks to turn
-- as many jumps as possible into fall throughs.
--

141
142
pprBBlock :: Platform -> CmmBasicBlock -> SDoc
pprBBlock platform (BasicBlock lbl stmts) =
143
    if null stmts then
dterei's avatar
dterei committed
144
        pprTrace "pprC.pprBBlock: curious empty code block for"
145
                        (pprBlockId lbl) empty
dterei's avatar
dterei committed
146
    else
147
        nest 4 (pprBlockId lbl <> colon) $$
148
        nest 8 (vcat (map (pprStmt platform) stmts))
149
150

-- --------------------------------------------------------------------------
dterei's avatar
dterei committed
151
-- Info tables. Just arrays of words.
152
153
-- See codeGen/ClosureInfo, and nativeGen/PprMach

154
155
pprWordArray :: Platform -> CLabel -> [CmmStatic] -> SDoc
pprWordArray platform lbl ds
Ian Lynagh's avatar
Ian Lynagh committed
156
  = hcat [ pprLocalness lbl, ptext (sLit "StgWord")
dterei's avatar
dterei committed
157
         , space, pprCLabel platform lbl, ptext (sLit "[] = {") ]
158
    $$ nest 8 (commafy (pprStatics platform ds))
Ian Lynagh's avatar
Ian Lynagh committed
159
    $$ ptext (sLit "};")
160
161
162
163
164

--
-- has to be static, if it isn't globally visible
--
pprLocalness :: CLabel -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
165
pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext (sLit "static ")
166
167
168
169
170
171
                 | otherwise = empty

-- --------------------------------------------------------------------------
-- Statements.
--

172
pprStmt :: Platform -> CmmStmt -> SDoc
173

174
pprStmt platform stmt = case stmt of
dterei's avatar
dterei committed
175
    CmmReturn _  -> panic "pprStmt: return statement should have been cps'd away"
176
    CmmNop       -> empty
dterei's avatar
dterei committed
177
    CmmComment _ -> empty -- (hang (ptext (sLit "/*")) 3 (ftext s)) $$ ptext (sLit "*/")
Simon Marlow's avatar
Simon Marlow committed
178
179
180
181
                          -- XXX if the string contains "*/", we need to fix it
                          -- XXX we probably want to emit these comments when
                          -- some debugging option is on.  They can get quite
                          -- large.
182

183
    CmmAssign dest src -> pprAssign platform dest src
184
185

    CmmStore  dest src
dterei's avatar
dterei committed
186
187
188
189
        | typeWidth rep == W64 && wordWidth /= W64
        -> (if isFloatType rep then ptext (sLit "ASSIGN_DBL")
                               else ptext (sLit ("ASSIGN_Word64"))) <>
           parens (mkP_ <> pprExpr1 platform dest <> comma <> pprExpr platform src) <> semi
190

dterei's avatar
dterei committed
191
192
193
194
        | otherwise
        -> hsep [ pprExpr platform (CmmLoad dest rep), equals, pprExpr platform src <> semi ]
        where
          rep = cmmExprType src
195

196
    CmmCall (CmmCallee fn cconv) results args ret ->
197
        maybe_proto $$
dterei's avatar
dterei committed
198
199
        fnCall
        where
200
        cast_fn = parens (cCast platform (pprCFunType (char '*') cconv results args) fn)
201

dterei's avatar
dterei committed
202
203
        real_fun_proto lbl = char ';' <>
                        pprCFunType (pprCLabel platform lbl) cconv results args <>
204
205
                        noreturn_attr <> semi

206
        fun_proto lbl = ptext (sLit ";EF_(") <>
207
                         pprCLabel platform lbl <> char ')' <> semi
208
209
210
211

        noreturn_attr = case ret of
                          CmmNeverReturns -> text "__attribute__ ((noreturn))"
                          CmmMayReturn    -> empty
212

213
        -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
dterei's avatar
dterei committed
214
        (maybe_proto, fnCall) =
215
            case fn of
dterei's avatar
dterei committed
216
              CmmLit (CmmLabel lbl)
217
                | StdCallConv <- cconv ->
218
                    let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
219
                    in (real_fun_proto lbl, myCall)
220
221
222
223
224
                        -- stdcall functions must be declared with
                        -- a function type, otherwise the C compiler
                        -- doesn't add the @n suffix to the label.  We
                        -- can't add the @n suffix ourselves, because
                        -- it isn't valid C.
225
                | CmmNeverReturns <- ret ->
226
                    let myCall = pprCall platform (pprCLabel platform lbl) cconv results args
227
                    in (real_fun_proto lbl, myCall)
228
                | not (isMathFun lbl) ->
229
230
231
                    let myCall = braces (
                                     pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
                                  $$ text "ghcFunPtr" <+> equals <+> cast_fn <> semi
232
                                  $$ pprCall platform (text "ghcFunPtr") cconv results args <> semi
233
234
                                 )
                    in (fun_proto lbl, myCall)
dterei's avatar
dterei committed
235
              _ ->
236
                   (empty {- no proto -},
237
                    pprCall platform cast_fn cconv results args <> semi)
dterei's avatar
dterei committed
238
                        -- for a dynamic call, no declaration is necessary.
239

240
241
    CmmCall (CmmPrim op) results args _ret ->
        pprCall platform ppr_fn CCallConv results args'
dterei's avatar
dterei committed
242
243
244
245
246
        where
        ppr_fn = pprCallishMachOp_for_C op
        -- The mem primops carry an extra alignment arg, must drop it.
        -- We could maybe emit an alignment directive using this info.
        args'  | op == MO_Memcpy || op == MO_Memset || op == MO_Memmove = init args
247
               | otherwise = args
248
249

    CmmBranch ident          -> pprBranch ident
250
251
252
    CmmCondBranch expr ident -> pprCondBranch platform expr ident
    CmmJump lbl _params      -> mkJMP_(pprExpr platform lbl) <> semi
    CmmSwitch arg ids        -> pprSwitch platform arg ids
253

254
pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc
255
256
pprCFunType ppr_fn cconv ress args
  = res_type ress <+>
Ian Lynagh's avatar
Ian Lynagh committed
257
    parens (ccallConvAttribute cconv <> ppr_fn) <>
258
    parens (commafy (map arg_type args))
259
  where
dterei's avatar
dterei committed
260
261
262
        res_type [] = ptext (sLit "void")
        res_type [CmmHinted one hint] = machRepHintCType (localRegType one) hint
        res_type _ = panic "pprCFunType: only void or 1 return value supported"
263

dterei's avatar
dterei committed
264
        arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprType expr) hint
265
266
267
268

-- ---------------------------------------------------------------------
-- unconditional branches
pprBranch :: BlockId -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
269
pprBranch ident = ptext (sLit "goto") <+> pprBlockId ident <> semi
270
271
272
273


-- ---------------------------------------------------------------------
-- conditional branches to local labels
274
275
276
pprCondBranch :: Platform -> CmmExpr -> BlockId -> SDoc
pprCondBranch platform expr ident
        = hsep [ ptext (sLit "if") , parens(pprExpr platform expr) ,
Ian Lynagh's avatar
Ian Lynagh committed
277
                        ptext (sLit "goto") , (pprBlockId ident) <> semi ]
278
279
280
281
282
283
284
285
286
287
288


-- ---------------------------------------------------------------------
-- a local table branch
--
-- we find the fall-through cases
--
-- N.B. we remove Nothing's from the list of branches, as they are
-- 'undefined'. However, they may be defined one day, so we better
-- document this behaviour.
--
289
pprSwitch :: Platform -> CmmExpr -> [ Maybe BlockId ] -> SDoc
dterei's avatar
dterei committed
290
pprSwitch platform e maybe_ids
291
  = let pairs  = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
dterei's avatar
dterei committed
292
293
        pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
    in
294
        (hang (ptext (sLit "switch") <+> parens ( pprExpr platform e ) <+> lbrace)
295
                4 (vcat ( map caseify pairs2 )))
296
297
298
        $$ rbrace

  where
299
    sndEq (_,x) (_,y) = x == y
300

301
302
    -- fall through case
    caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
dterei's avatar
dterei committed
303
304
        where
        do_fallthrough ix =
305
                 hsep [ ptext (sLit "case") , pprHexVal ix wordWidth <> colon ,
Ian Lynagh's avatar
Ian Lynagh committed
306
                        ptext (sLit "/* fall through */") ]
307

dterei's avatar
dterei committed
308
309
        final_branch ix =
                hsep [ ptext (sLit "case") , pprHexVal ix wordWidth <> colon ,
Ian Lynagh's avatar
Ian Lynagh committed
310
                       ptext (sLit "goto") , (pprBlockId ident) <> semi ]
311

dterei's avatar
dterei committed
312
313
    caseify (_     , _    ) = panic "pprSwtich: swtich with no cases!"

314
315
316
317
318
319
-- ---------------------------------------------------------------------
-- Expressions.
--

-- C Types: the invariant is that the C expression generated by
--
dterei's avatar
dterei committed
320
--      pprExpr e
321
322
323
--
-- has a type in C which is also given by
--
dterei's avatar
dterei committed
324
--      machRepCType (cmmExprType e)
325
326
327
--
-- (similar invariants apply to the rest of the pretty printer).

328
329
330
pprExpr :: Platform -> CmmExpr -> SDoc
pprExpr platform e = case e of
    CmmLit lit -> pprLit platform lit
331
332


333
    CmmLoad e ty -> pprLoad platform e ty
334
335
336
337
    CmmReg reg      -> pprCastReg reg
    CmmRegOff reg 0 -> pprCastReg reg

    CmmRegOff reg i
dterei's avatar
dterei committed
338
339
        | i >  0    -> pprRegOff (char '+') i
        | otherwise -> pprRegOff (char '-') (-i)
340
      where
dterei's avatar
dterei committed
341
        pprRegOff op i' = pprCastReg reg <> op <> int i'
342

343
    CmmMachOp mop args -> pprMachOpApp platform mop args
344

dterei's avatar
dterei committed
345
346
    CmmStackSlot _ _   -> panic "pprExpr: CmmStackSlot not supported!"

347

348
349
pprLoad :: Platform -> CmmExpr -> CmmType -> SDoc
pprLoad platform e ty
350
351
  | width == W64, wordWidth /= W64
  = (if isFloatType ty then ptext (sLit "PK_DBL")
dterei's avatar
dterei committed
352
                       else ptext (sLit "PK_Word64"))
353
    <> parens (mkP_ <> pprExpr1 platform e)
354

dterei's avatar
dterei committed
355
  | otherwise
356
  = case e of
dterei's avatar
dterei committed
357
358
        CmmReg r | isPtrReg r && width == wordWidth && not (isFloatType ty)
                 -> char '*' <> pprAsPtrReg r
359

dterei's avatar
dterei committed
360
361
        CmmRegOff r 0 | isPtrReg r && width == wordWidth && not (isFloatType ty)
                      -> char '*' <> pprAsPtrReg r
362

dterei's avatar
dterei committed
363
364
365
        CmmRegOff r off | isPtrReg r && width == wordWidth
                        , off `rem` wORD_SIZE == 0 && not (isFloatType ty)
        -- ToDo: check that the offset is a word multiple?
366
        --       (For tagging to work, I had to avoid unaligned loads. --ARY)
dterei's avatar
dterei committed
367
                        -> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift))
368

dterei's avatar
dterei committed
369
        _other -> cLoad platform e ty
370
371
372
  where
    width = typeWidth ty

373
374
375
376
pprExpr1 :: Platform -> CmmExpr -> SDoc
pprExpr1 platform (CmmLit lit)     = pprLit1 platform lit
pprExpr1 platform e@(CmmReg _reg)  = pprExpr platform e
pprExpr1 platform other            = parens (pprExpr platform other)
377
378
379
380

-- --------------------------------------------------------------------------
-- MachOp applications

381
pprMachOpApp :: Platform -> MachOp -> [CmmExpr] -> SDoc
382

383
pprMachOpApp platform op args
384
  | isMulMayOfloOp op
385
  = ptext (sLit "mulIntMayOflo") <> parens (commafy (map (pprExpr platform) args))
386
  where isMulMayOfloOp (MO_U_MulMayOflo _) = True
dterei's avatar
dterei committed
387
388
        isMulMayOfloOp (MO_S_MulMayOflo _) = True
        isMulMayOfloOp _ = False
389

390
pprMachOpApp platform mop args
dterei's avatar
dterei committed
391
  | Just ty <- machOpNeedsCast mop
392
  = ty <> parens (pprMachOpApp' platform mop args)
393
  | otherwise
394
  = pprMachOpApp' platform mop args
395
396
397
398
399
400
401
402
403

-- Comparisons in C have type 'int', but we want type W_ (this is what
-- resultRepOfMachOp says).  The other C operations inherit their type
-- from their operands, so no casting is required.
machOpNeedsCast :: MachOp -> Maybe SDoc
machOpNeedsCast mop
  | isComparisonMachOp mop = Just mkW_
  | otherwise              = Nothing

404
405
pprMachOpApp' :: Platform -> MachOp -> [CmmExpr] -> SDoc
pprMachOpApp' platform mop args
406
407
408
409
410
411
412
413
414
415
 = case args of
    -- dyadic
    [x,y] -> pprArg x <+> pprMachOp_for_C mop <+> pprArg y

    -- unary
    [x]   -> pprMachOp_for_C mop <> parens (pprArg x)

    _     -> panic "PprC.pprMachOp : machop with wrong number of args"

  where
dterei's avatar
dterei committed
416
        -- Cast needed for signed integer ops
417
418
    pprArg e | signedOp    mop = cCast platform (machRep_S_CType (typeWidth (cmmExprType e))) e
             | needsFCasts mop = cCast platform (machRep_F_CType (typeWidth (cmmExprType e))) e
dterei's avatar
dterei committed
419
             | otherwise    = pprExpr1 platform e
420
421
422
423
424
    needsFCasts (MO_F_Eq _)   = False
    needsFCasts (MO_F_Ne _)   = False
    needsFCasts (MO_F_Neg _)  = True
    needsFCasts (MO_F_Quot _) = True
    needsFCasts mop  = floatComparison mop
425
426
427
428

-- --------------------------------------------------------------------------
-- Literals

429
430
pprLit :: Platform -> CmmLit -> SDoc
pprLit platform lit = case lit of
431
    CmmInt i rep      -> pprHexVal i rep
432

433
    CmmFloat f w       -> parens (machRep_F_CType w) <> str
434
435
436
437
438
439
440
441
        where d = fromRational f :: Double
              str | isInfinite d && d < 0 = ptext (sLit "-INFINITY")
                  | isInfinite d          = ptext (sLit "INFINITY")
                  | isNaN d               = ptext (sLit "NAN")
                  | otherwise             = text (show d)
                -- these constants come from <math.h>
                -- see #1861

442
443
    CmmBlock bid       -> mkW_ <> pprCLabelAddr (infoTblLbl bid)
    CmmHighStackMark   -> panic "PprC printing high stack mark"
444
445
    CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
    CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
dterei's avatar
dterei committed
446
    CmmLabelDiffOff clbl1 _ i
447
        -- WARNING:
448
449
        --  * the lit must occur in the info table clbl2
        --  * clbl1 must be an SRT, a slow entry point or a large bitmap
450
451
        -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i

dterei's avatar
dterei committed
452
    where
453
        pprCLabelAddr lbl = char '&' <> pprCLabel platform lbl
454

455
456
457
458
459
pprLit1 :: Platform -> CmmLit -> SDoc
pprLit1 platform lit@(CmmLabelOff _ _) = parens (pprLit platform lit)
pprLit1 platform lit@(CmmLabelDiffOff _ _ _) = parens (pprLit platform lit)
pprLit1 platform lit@(CmmFloat _ _)    = parens (pprLit platform lit)
pprLit1 platform other = pprLit platform other
460
461
462
463

-- ---------------------------------------------------------------------------
-- Static data

464
465
pprStatics :: Platform -> [CmmStatic] -> [SDoc]
pprStatics _ [] = []
dterei's avatar
dterei committed
466
pprStatics platform (CmmStaticLit (CmmFloat f W32) : rest)
467
  -- floats are padded to a word, see #1852
468
  | wORD_SIZE == 8, CmmStaticLit (CmmInt 0 W32) : rest' <- rest
469
  = pprLit1 platform (floatToWord f) : pprStatics platform rest'
470
  | wORD_SIZE == 4
471
  = pprLit1 platform (floatToWord f) : pprStatics platform rest
472
  | otherwise
dterei's avatar
dterei committed
473
474
475
  = pprPanic "pprStatics: float" (vcat (map ppr' rest))
    where ppr' (CmmStaticLit l) = ppr (cmmLitType l)
          ppr' _other           = ptext (sLit "bad static!")
476
477
478
pprStatics platform (CmmStaticLit (CmmFloat f W64) : rest)
  = map (pprLit1 platform) (doubleToWords f) ++ pprStatics platform rest
pprStatics platform (CmmStaticLit (CmmInt i W64) : rest)
479
  | wordWidth == W32
480
#ifdef WORDS_BIGENDIAN
481
  = pprStatics platform (CmmStaticLit (CmmInt q W32) :
dterei's avatar
dterei committed
482
                CmmStaticLit (CmmInt r W32) : rest)
483
#else
484
  = pprStatics platform (CmmStaticLit (CmmInt r W32) :
dterei's avatar
dterei committed
485
                CmmStaticLit (CmmInt q W32) : rest)
486
487
#endif
  where r = i .&. 0xffffffff
dterei's avatar
dterei committed
488
        q = i `shiftR` 32
489
pprStatics _ (CmmStaticLit (CmmInt _ w) : _)
490
  | w /= wordWidth
491
  = panic "pprStatics: cannot emit a non-word-sized static literal"
492
493
494
495
pprStatics platform (CmmStaticLit lit : rest)
  = pprLit1 platform lit : pprStatics platform rest
pprStatics platform (other : _)
  = pprPanic "pprWord" (pprStatic platform other)
496

497
498
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
499

500
    CmmStaticLit lit   -> nest 4 (pprLit platform lit)
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
    CmmUninitialised i -> nest 4 (mkC_ <> brackets (int i))

    -- these should be inlined, like the old .hc
    CmmString s'       -> nest 4 (mkW_ <> parens(pprStringInCStyle s'))


-- ---------------------------------------------------------------------------
-- Block Ids

pprBlockId :: BlockId -> SDoc
pprBlockId b = char '_' <> ppr (getUnique b)

-- --------------------------------------------------------------------------
-- Print a MachOp in a way suitable for emitting via C.
--

pprMachOp_for_C :: MachOp -> SDoc

dterei's avatar
dterei committed
519
pprMachOp_for_C mop = case mop of
520
521
522
523

        -- Integer operations
        MO_Add          _ -> char '+'
        MO_Sub          _ -> char '-'
Ian Lynagh's avatar
Ian Lynagh committed
524
525
        MO_Eq           _ -> ptext (sLit "==")
        MO_Ne           _ -> ptext (sLit "!=")
526
527
528
529
530
531
532
533
534
        MO_Mul          _ -> char '*'

        MO_S_Quot       _ -> char '/'
        MO_S_Rem        _ -> char '%'
        MO_S_Neg        _ -> char '-'

        MO_U_Quot       _ -> char '/'
        MO_U_Rem        _ -> char '%'

535
536
537
538
539
540
541
542
        -- & Floating-point operations
        MO_F_Add        _ -> char '+'
        MO_F_Sub        _ -> char '-'
        MO_F_Neg        _ -> char '-'
        MO_F_Mul        _ -> char '*'
        MO_F_Quot       _ -> char '/'

        -- Signed comparisons
Ian Lynagh's avatar
Ian Lynagh committed
543
544
        MO_S_Ge         _ -> ptext (sLit ">=")
        MO_S_Le         _ -> ptext (sLit "<=")
545
546
547
        MO_S_Gt         _ -> char '>'
        MO_S_Lt         _ -> char '<'

548
        -- & Unsigned comparisons
Ian Lynagh's avatar
Ian Lynagh committed
549
550
        MO_U_Ge         _ -> ptext (sLit ">=")
        MO_U_Le         _ -> ptext (sLit "<=")
551
552
553
        MO_U_Gt         _ -> char '>'
        MO_U_Lt         _ -> char '<'

554
555
556
557
558
559
560
561
        -- & Floating-point comparisons
        MO_F_Eq         _ -> ptext (sLit "==")
        MO_F_Ne         _ -> ptext (sLit "!=")
        MO_F_Ge         _ -> ptext (sLit ">=")
        MO_F_Le         _ -> ptext (sLit "<=")
        MO_F_Gt         _ -> char '>'
        MO_F_Lt         _ -> char '<'

562
563
564
565
566
567
        -- Bitwise operations.  Not all of these may be supported at all
        -- sizes, and only integral MachReps are valid.
        MO_And          _ -> char '&'
        MO_Or           _ -> char '|'
        MO_Xor          _ -> char '^'
        MO_Not          _ -> char '~'
Ian Lynagh's avatar
Ian Lynagh committed
568
569
570
        MO_Shl          _ -> ptext (sLit "<<")
        MO_U_Shr        _ -> ptext (sLit ">>") -- unsigned shift right
        MO_S_Shr        _ -> ptext (sLit ">>") -- signed shift right
571

572
573
-- Conversions.  Some of these will be NOPs, but never those that convert
-- between ints and floats.
574
575
576
577
578
-- Floating-point conversions use the signed variant.
-- We won't know to generate (void*) casts here, but maybe from
-- context elsewhere

-- noop casts
579
        MO_UU_Conv from to | from == to -> empty
580
        MO_UU_Conv _from to -> parens (machRep_U_CType to)
581
582

        MO_SS_Conv from to | from == to -> empty
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
        MO_SS_Conv _from to -> parens (machRep_S_CType to)

        MO_FF_Conv from to | from == to -> empty
        MO_FF_Conv _from to -> parens (machRep_F_CType to)

        MO_SF_Conv _from to -> parens (machRep_F_CType to)
        MO_FS_Conv _from to -> parens (machRep_S_CType to)
        
        MO_S_MulMayOflo _ -> pprTrace "offending mop:"
                                (ptext $ sLit "MO_S_MulMayOflo")
                                (panic $ "PprC.pprMachOp_for_C: MO_S_MulMayOflo"
                                      ++ " should have been handled earlier!")
        MO_U_MulMayOflo _ -> pprTrace "offending mop:"
                                (ptext $ sLit "MO_U_MulMayOflo")
                                (panic $ "PprC.pprMachOp_for_C: MO_U_MulMayOflo"
                                      ++ " should have been handled earlier!")
599

dterei's avatar
dterei committed
600
signedOp :: MachOp -> Bool      -- Argument type(s) are signed ints
dterei's avatar
dterei committed
601
602
603
604
605
606
607
608
signedOp (MO_S_Quot _)    = True
signedOp (MO_S_Rem  _)    = True
signedOp (MO_S_Neg  _)    = True
signedOp (MO_S_Ge   _)    = True
signedOp (MO_S_Le   _)    = True
signedOp (MO_S_Gt   _)    = True
signedOp (MO_S_Lt   _)    = True
signedOp (MO_S_Shr  _)    = True
609
610
signedOp (MO_SS_Conv _ _) = True
signedOp (MO_SF_Conv _ _) = True
dterei's avatar
dterei committed
611
signedOp _                = False
612

613
floatComparison :: MachOp -> Bool  -- comparison between float args
dterei's avatar
dterei committed
614
615
616
617
618
619
620
floatComparison (MO_F_Eq   _) = True
floatComparison (MO_F_Ne   _) = True
floatComparison (MO_F_Ge   _) = True
floatComparison (MO_F_Le   _) = True
floatComparison (MO_F_Gt   _) = True
floatComparison (MO_F_Lt   _) = True
floatComparison _             = False
621

622
623
624
625
626
-- ---------------------------------------------------------------------
-- tend to be implemented by foreign calls

pprCallishMachOp_for_C :: CallishMachOp -> SDoc

dterei's avatar
dterei committed
627
pprCallishMachOp_for_C mop
628
    = case mop of
dterei's avatar
dterei committed
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
        MO_F64_Pwr      -> ptext (sLit "pow")
        MO_F64_Sin      -> ptext (sLit "sin")
        MO_F64_Cos      -> ptext (sLit "cos")
        MO_F64_Tan      -> ptext (sLit "tan")
        MO_F64_Sinh     -> ptext (sLit "sinh")
        MO_F64_Cosh     -> ptext (sLit "cosh")
        MO_F64_Tanh     -> ptext (sLit "tanh")
        MO_F64_Asin     -> ptext (sLit "asin")
        MO_F64_Acos     -> ptext (sLit "acos")
        MO_F64_Atan     -> ptext (sLit "atan")
        MO_F64_Log      -> ptext (sLit "log")
        MO_F64_Exp      -> ptext (sLit "exp")
        MO_F64_Sqrt     -> ptext (sLit "sqrt")
        MO_F32_Pwr      -> ptext (sLit "powf")
        MO_F32_Sin      -> ptext (sLit "sinf")
        MO_F32_Cos      -> ptext (sLit "cosf")
        MO_F32_Tan      -> ptext (sLit "tanf")
        MO_F32_Sinh     -> ptext (sLit "sinhf")
        MO_F32_Cosh     -> ptext (sLit "coshf")
        MO_F32_Tanh     -> ptext (sLit "tanhf")
        MO_F32_Asin     -> ptext (sLit "asinf")
        MO_F32_Acos     -> ptext (sLit "acosf")
        MO_F32_Atan     -> ptext (sLit "atanf")
        MO_F32_Log      -> ptext (sLit "logf")
        MO_F32_Exp      -> ptext (sLit "expf")
        MO_F32_Sqrt     -> ptext (sLit "sqrtf")
655
        MO_WriteBarrier -> ptext (sLit "write_barrier")
dterei's avatar
dterei committed
656
657
658
        MO_Memcpy       -> ptext (sLit "memcpy")
        MO_Memset       -> ptext (sLit "memset")
        MO_Memmove      -> ptext (sLit "memmove")
dterei's avatar
dterei committed
659
660
661
        (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)

        MO_Touch -> panic $ "pprCallishMachOp_for_C: MO_Touch not supported!"
662
663
664
665
666
667
668

-- ---------------------------------------------------------------------
-- Useful #defines
--

mkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc

Ian Lynagh's avatar
Ian Lynagh committed
669
670
671
mkJMP_ i = ptext (sLit "JMP_") <> parens i
mkFN_  i = ptext (sLit "FN_")  <> parens i -- externally visible function
mkIF_  i = ptext (sLit "IF_")  <> parens i -- locally visible
672
673
674


mkFB_, mkFE_ :: SDoc
Ian Lynagh's avatar
Ian Lynagh committed
675
676
mkFB_ = ptext (sLit "FB_") -- function code begin
mkFE_ = ptext (sLit "FE_") -- function code end
677
678
679

-- from includes/Stg.h
--
Simon Marlow's avatar
Simon Marlow committed
680
mkC_,mkW_,mkP_ :: SDoc
681

Ian Lynagh's avatar
Ian Lynagh committed
682
683
684
mkC_  = ptext (sLit "(C_)")        -- StgChar
mkW_  = ptext (sLit "(W_)")        -- StgWord
mkP_  = ptext (sLit "(P_)")        -- StgWord*
685
686
687
688
689
690
691

-- ---------------------------------------------------------------------
--
-- Assignments
--
-- Generating assignments is what we're all about, here
--
692
pprAssign :: Platform -> CmmReg -> CmmExpr -> SDoc
693
694

-- dest is a reg, rhs is a reg
695
pprAssign _ r1 (CmmReg r2)
696
   | isPtrReg r1 && isPtrReg r2
697
698
699
   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, semi ]

-- dest is a reg, rhs is a CmmRegOff
700
pprAssign _ r1 (CmmRegOff r2 off)
701
   | isPtrReg r1 && isPtrReg r2 && (off `rem` wORD_SIZE == 0)
702
703
   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]
  where
dterei's avatar
dterei committed
704
        off1 = off `shiftR` wordShift
705

dterei's avatar
dterei committed
706
707
        (op,off') | off >= 0  = (char '+', off1)
                  | otherwise = (char '-', -off1)
708

709
710
711
-- dest is a reg, rhs is anything.
-- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
-- the lvalue elicits a warning from new GCC versions (3.4+).
712
713
714
715
pprAssign platform r1 r2
  | isFixedPtrReg r1             = mkAssign (mkP_ <> pprExpr1 platform r2)
  | Just ty <- strangeRegType r1 = mkAssign (parens ty <> pprExpr1 platform r2)
  | otherwise                    = mkAssign (pprExpr platform r2)
Ian Lynagh's avatar
Ian Lynagh committed
716
    where mkAssign x = if r1 == CmmGlobal BaseReg
Ian Lynagh's avatar
Ian Lynagh committed
717
718
                       then ptext (sLit "ASSIGN_BaseReg") <> parens x <> semi
                       else pprReg r1 <> ptext (sLit " = ") <> x <> semi
719
720
721
722

-- ---------------------------------------------------------------------
-- Registers

dterei's avatar
dterei committed
723
pprCastReg :: CmmReg -> SDoc
724
725
726
727
pprCastReg reg
   | isStrangeTypeReg reg = mkW_ <> pprReg reg
   | otherwise            = pprReg reg

728
729
730
731
732
733
-- True if (pprReg reg) will give an expression with type StgPtr.  We
-- need to take care with pointer arithmetic on registers with type
-- StgPtr.
isFixedPtrReg :: CmmReg -> Bool
isFixedPtrReg (CmmLocal _) = False
isFixedPtrReg (CmmGlobal r) = isFixedPtrGlobalReg r
734

735
-- True if (pprAsPtrReg reg) will give an expression with type StgPtr
736
737
738
-- JD: THIS IS HORRIBLE AND SHOULD BE RENAMED, AT THE VERY LEAST.
-- THE GARBAGE WITH THE VNonGcPtr HELPS MATCH THE OLD CODE GENERATOR'S OUTPUT;
-- I'M NOT SURE IF IT SHOULD REALLY STAY THAT WAY.
739
isPtrReg :: CmmReg -> Bool
dterei's avatar
dterei committed
740
741
742
743
isPtrReg (CmmLocal _)                         = False
isPtrReg (CmmGlobal (VanillaReg _ VGcPtr))    = True  -- if we print via pprAsPtrReg
isPtrReg (CmmGlobal (VanillaReg _ VNonGcPtr)) = False -- if we print via pprAsPtrReg
isPtrReg (CmmGlobal reg)                      = isFixedPtrGlobalReg reg
744
745
746

-- True if this global reg has type StgPtr
isFixedPtrGlobalReg :: GlobalReg -> Bool
dterei's avatar
dterei committed
747
748
749
750
751
isFixedPtrGlobalReg Sp    = True
isFixedPtrGlobalReg Hp    = True
isFixedPtrGlobalReg HpLim = True
isFixedPtrGlobalReg SpLim = True
isFixedPtrGlobalReg _     = False
752

dterei's avatar
dterei committed
753
-- True if in C this register doesn't have the type given by
754
-- (machRepCType (cmmRegType reg)), so it has to be cast.
755
isStrangeTypeReg :: CmmReg -> Bool
dterei's avatar
dterei committed
756
757
isStrangeTypeReg (CmmLocal _)   = False
isStrangeTypeReg (CmmGlobal g)  = isStrangeTypeGlobal g
758
759

isStrangeTypeGlobal :: GlobalReg -> Bool
760
isStrangeTypeGlobal CCCS                = True
dterei's avatar
dterei committed
761
762
763
764
isStrangeTypeGlobal CurrentTSO          = True
isStrangeTypeGlobal CurrentNursery      = True
isStrangeTypeGlobal BaseReg             = True
isStrangeTypeGlobal r                   = isFixedPtrGlobalReg r
765

766
strangeRegType :: CmmReg -> Maybe SDoc
767
strangeRegType (CmmGlobal CCCS) = Just (ptext (sLit "struct CostCentreStack_ *"))
Ian Lynagh's avatar
Ian Lynagh committed
768
769
770
strangeRegType (CmmGlobal CurrentTSO) = Just (ptext (sLit "struct StgTSO_ *"))
strangeRegType (CmmGlobal CurrentNursery) = Just (ptext (sLit "struct bdescr_ *"))
strangeRegType (CmmGlobal BaseReg) = Just (ptext (sLit "struct StgRegTable_ *"))
771
strangeRegType _ = Nothing
772
773
774
775
776
777
778

-- pprReg just prints the register name.
--
pprReg :: CmmReg -> SDoc
pprReg r = case r of
        CmmLocal  local  -> pprLocalReg local
        CmmGlobal global -> pprGlobalReg global
dterei's avatar
dterei committed
779

780
pprAsPtrReg :: CmmReg -> SDoc
dterei's avatar
dterei committed
781
pprAsPtrReg (CmmGlobal (VanillaReg n gcp))
782
  = WARN( gcp /= VGcPtr, ppr n ) char 'R' <> int n <> ptext (sLit ".p")
783
784
785
786
pprAsPtrReg other_reg = pprReg other_reg

pprGlobalReg :: GlobalReg -> SDoc
pprGlobalReg gr = case gr of
787
    VanillaReg n _ -> char 'R' <> int n  <> ptext (sLit ".w")
dterei's avatar
dterei committed
788
789
790
        -- pprGlobalReg prints a VanillaReg as a .w regardless
        -- Example:     R1.w = R1.w & (-0x8UL);
        --              JMP_(*R1.p);
791
792
793
    FloatReg   n   -> char 'F' <> int n
    DoubleReg  n   -> char 'D' <> int n
    LongReg    n   -> char 'L' <> int n
Ian Lynagh's avatar
Ian Lynagh committed
794
795
796
797
    Sp             -> ptext (sLit "Sp")
    SpLim          -> ptext (sLit "SpLim")
    Hp             -> ptext (sLit "Hp")
    HpLim          -> ptext (sLit "HpLim")
798
    CCCS           -> ptext (sLit "CCCS")
Ian Lynagh's avatar
Ian Lynagh committed
799
800
801
802
    CurrentTSO     -> ptext (sLit "CurrentTSO")
    CurrentNursery -> ptext (sLit "CurrentNursery")
    HpAlloc        -> ptext (sLit "HpAlloc")
    BaseReg        -> ptext (sLit "BaseReg")
803
    EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
Ian Lynagh's avatar
Ian Lynagh committed
804
805
    GCEnter1       -> ptext (sLit "stg_gc_enter_1")
    GCFun          -> ptext (sLit "stg_gc_fun")
dterei's avatar
dterei committed
806
    other          -> panic $ "pprGlobalReg: Unsupported register: " ++ show other
807
808

pprLocalReg :: LocalReg -> SDoc
809
pprLocalReg (LocalReg uniq _) = char '_' <> ppr uniq
810
811
812
813

-- -----------------------------------------------------------------------------
-- Foreign Calls

814
pprCall :: Platform -> SDoc -> CCallConv
815
        -> [HintedCmmFormal] -> [HintedCmmActual]
816
        -> SDoc
817

818
pprCall platform ppr_fn cconv results args
dterei's avatar
dterei committed
819
820
  | not (is_cishCC cconv)
  = panic $ "pprCall: unknown calling convention"
821
822

  | otherwise
823
824
  =
    ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
dterei's avatar
dterei committed
825
  where
Simon Marlow's avatar
Simon Marlow committed
826
     ppr_assign []           rhs = rhs
827
     ppr_assign [CmmHinted one hint] rhs
dterei's avatar
dterei committed
828
829
         = pprLocalReg one <> ptext (sLit " = ")
                 <> pprUnHint hint (localRegType one) <> rhs
Simon Marlow's avatar
Simon Marlow committed
830
     ppr_assign _other _rhs = panic "pprCall: multiple results"
831

832
     pprArg (CmmHinted expr AddrHint)
dterei's avatar
dterei committed
833
834
        = cCast platform (ptext (sLit "void *")) expr
        -- see comment by machRepHintCType below
835
     pprArg (CmmHinted expr SignedHint)
dterei's avatar
dterei committed
836
        = cCast platform (machRep_S_CType $ typeWidth $ cmmExprType expr) expr
837
     pprArg (CmmHinted expr _other)
dterei's avatar
dterei committed
838
        = pprExpr platform expr
839

840
     pprUnHint AddrHint   rep = parens (machRepCType rep)
841
842
843
     pprUnHint SignedHint rep = parens (machRepCType rep)
     pprUnHint _          _   = empty

844
845
-- Currently we only have these two calling conventions, but this might
-- change in the future...
dterei's avatar
dterei committed
846
847
is_cishCC :: CCallConv -> Bool
is_cishCC CCallConv    = True
848
is_cishCC CApiConv     = True
dterei's avatar
dterei committed
849
850
851
is_cishCC StdCallConv  = True
is_cishCC CmmCallConv  = False
is_cishCC PrimCallConv = False
852
853
854
855

-- ---------------------------------------------------------------------
-- Find and print local and external declarations for a list of
-- Cmm statements.
dterei's avatar
dterei committed
856
--
857
858
859
pprTempAndExternDecls :: Platform -> [CmmBasicBlock]
                      -> (SDoc{-temps-}, SDoc{-externs-})
pprTempAndExternDecls platform stmts
dterei's avatar
dterei committed
860
  = (vcat (map pprTempDecl (uniqSetToList temps)),
861
     vcat (map (pprExternDecl platform False{-ToDo-}) (Map.keys lbls)))
862
863
  where (temps, lbls) = runTE (mapM_ te_BB stmts)

864
865
866
pprDataExterns :: Platform -> [CmmStatic] -> SDoc
pprDataExterns platform statics
  = vcat (map (pprExternDecl platform False{-ToDo-}) (Map.keys lbls))
867
868
869
  where (_, lbls) = runTE (mapM_ te_Static statics)

pprTempDecl :: LocalReg -> SDoc
870
pprTempDecl l@(LocalReg _ rep)
871
872
  = hcat [ machRepCType rep, space, pprLocalReg l, semi ]

873
874
pprExternDecl :: Platform -> Bool -> CLabel -> SDoc
pprExternDecl platform _in_srt lbl
875
876
  -- do not print anything for "known external" things
  | not (needsCDecl lbl) = empty
877
878
  | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz
  | otherwise =
dterei's avatar
dterei committed
879
880
        hcat [ visibility, label_type lbl,
               lparen, pprCLabel platform lbl, text ");" ]
881
 where
882
  label_type lbl | isCFunctionLabel lbl = ptext (sLit "F_")
dterei's avatar
dterei committed
883
                 | otherwise            = ptext (sLit "I_")
884
885
886

  visibility
     | externallyVisibleCLabel lbl = char 'E'
dterei's avatar
dterei committed
887
     | otherwise                   = char 'I'
888

889
890
891
892
  -- If the label we want to refer to is a stdcall function (on Windows) then
  -- we must generate an appropriate prototype for it, so that the C compiler will
  -- add the @n suffix to the label (#2276)
  stdcall_decl sz =
893
        ptext (sLit "extern __attribute__((stdcall)) void ") <> pprCLabel platform lbl
894
        <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
895
        <> semi
896

897
type TEState = (UniqSet LocalReg, Map CLabel ())
898
899
900
901
902
903
904
newtype TE a = TE { unTE :: TEState -> (a, TEState) }

instance Monad TE where
   TE m >>= k  = TE $ \s -> case m s of (a, s') -> unTE (k a) s'
   return a    = TE $ \s -> (a, s)

te_lbl :: CLabel -> TE ()
905
te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))
906
907
908
909
910

te_temp :: LocalReg -> TE ()
te_temp r = TE $ \(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))

runTE :: TE () -> TEState
911
runTE (TE m) = snd (m (emptyUniqSet, Map.empty))
912
913
914
915
916
917

te_Static :: CmmStatic -> TE ()
te_Static (CmmStaticLit lit) = te_Lit lit
te_Static _ = return ()

te_BB :: CmmBasicBlock -> TE ()
dterei's avatar
dterei committed
918
te_BB (BasicBlock _ ss)         = mapM_ te_Stmt ss
919
920
921

te_Lit :: CmmLit -> TE ()
te_Lit (CmmLabel l) = te_lbl l
922
te_Lit (CmmLabelOff l _) = te_lbl l
dterei's avatar
dterei committed
923
te_Lit (CmmLabelDiffOff l1 _ _) = te_lbl l1
924
925
926
te_Lit _ = return ()

te_Stmt :: CmmStmt -> TE ()
dterei's avatar
dterei committed
927
928
te_Stmt (CmmAssign r e)         = te_Reg r >> te_Expr e
te_Stmt (CmmStore l r)          = te_Expr l >> te_Expr r
929
te_Stmt (CmmCall _ rs es _)     = mapM_ (te_temp.hintlessCmm) rs >>
dterei's avatar
dterei committed
930
931
932
933
934
                                  mapM_ (te_Expr.hintlessCmm) es
te_Stmt (CmmCondBranch e _)     = te_Expr e
te_Stmt (CmmSwitch e _)         = te_Expr e
te_Stmt (CmmJump e _)           = te_Expr e
te_Stmt _                       = return ()
935
936

te_Expr :: CmmExpr -> TE ()
dterei's avatar
dterei committed
937
938
939
940
941
te_Expr (CmmLit lit)            = te_Lit lit
te_Expr (CmmLoad e _)           = te_Expr e
te_Expr (CmmReg r)              = te_Reg r
te_Expr (CmmMachOp _ es)        = mapM_ te_Expr es
te_Expr (CmmRegOff r _)         = te_Reg r
dterei's avatar
dterei committed
942
te_Expr (CmmStackSlot _ _)      = panic "te_Expr: CmmStackSlot not supported!"
943
944
945
946
947