32159f1dc9866becc1b6c71417cc4fa3d22cc634
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1996
3 %
4 \section[MachRegs]{Machine-specific info about registers}
5
6 Also includes stuff about immediate operands, which are
7 often/usually quite entangled with registers.
8
9 (Immediates could be untangled from registers at some cost in tangled
10 modules --- the pleasure has been foregone.)
11
12 \begin{code}
13 #include "HsVersions.h"
14 #include "nativeGen/NCG.h"
15
16 module MachRegs (
17
18         Reg(..),
19         Imm(..),
20         Addr(..),
21         RegLoc(..),
22         RegNo(..),
23
24         addrOffset,
25         argRegs,
26         baseRegOffset,
27         callClobberedRegs,
28         callerSaves,
29         dblImmLit,
30         extractMappedRegNos,
31         freeMappedRegs,
32         freeReg, freeRegs,
33         getNewRegNCG,
34         magicIdRegMaybe,
35         mkReg,
36         realReg,
37         reservedRegs,
38         saveLoc,
39         spRel,
40         stgReg,
41         strImmLit
42
43 #if alpha_TARGET_ARCH
44         , allArgRegs
45         , fits8Bits
46         , fReg
47         , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zero
48 #endif
49 #if i386_TARGET_ARCH
50         , eax, ebx, ecx, edx, esi, esp
51         , st0, st1, st2, st3, st4, st5, st6, st7
52 #endif
53 #if sparc_TARGET_ARCH
54         , allArgRegs
55         , fits13Bits
56         , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
57         , fp, g0, o0, f0
58         
59 #endif
60     ) where
61
62 import Ubiq{-uitous-}
63
64 import AbsCSyn          ( MagicId(..) )
65 import AbsCUtils        ( magicIdPrimRep )
66 import Pretty           ( ppStr, ppRational, ppShow )
67 import PrimOp           ( PrimOp(..) )
68 import PrimRep          ( PrimRep(..) )
69 import Stix             ( sStLitLbl, StixTree(..), StixReg(..),
70                           CodeSegment
71                         )
72 import Unique           ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
73                           Unique{-instance Ord3-}
74                         )
75 import UniqSupply       ( getUnique, returnUs, thenUs, UniqSM(..) )
76 import Unpretty         ( uppStr, Unpretty(..) )
77 import Util             ( panic )
78 \end{code}
79
80 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
81
82 \begin{code}
83 data Imm
84   = ImmInt      Int
85   | ImmInteger  Integer     -- Sigh.
86   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
87   | ImmLab      Unpretty    -- Simple string label (underscore-able)
88   | ImmLit      Unpretty    -- Simple string
89   IF_ARCH_sparc(
90   | LO Imm                  -- Possible restrictions...
91   | HI Imm
92   ,)
93
94 strImmLit s = ImmLit (uppStr s)
95 dblImmLit r
96   = strImmLit (
97          IF_ARCH_alpha({-prepend nothing-}
98         ,IF_ARCH_i386( '0' : 'd' :
99         ,IF_ARCH_sparc('0' : 'r' :,)))
100         ppShow 80 (ppRational r))
101 \end{code}
102
103 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
104
105 \begin{code}
106 data Addr
107 #if alpha_TARGET_ARCH
108   = AddrImm     Imm
109   | AddrReg     Reg
110   | AddrRegImm  Reg Imm
111 #endif
112
113 #if i386_TARGET_ARCH
114   = Addr        Base Index Displacement
115   | ImmAddr     Imm Int
116
117 type Base         = Maybe Reg
118 type Index        = Maybe (Reg, Int)    -- Int is 2, 4 or 8
119 type Displacement = Imm
120 #endif
121
122 #if sparc_TARGET_ARCH
123   = AddrRegReg  Reg Reg
124   | AddrRegImm  Reg Imm
125 #endif
126
127 addrOffset :: Addr -> Int -> Maybe Addr
128
129 addrOffset addr off
130   = case addr of
131 #if alpha_TARGET_ARCH
132       _ -> panic "MachMisc.addrOffset not defined for Alpha"
133 #endif
134 #if i386_TARGET_ARCH
135       ImmAddr i off0      -> Just (ImmAddr i (off0 + off))
136       Addr r i (ImmInt n) -> Just (Addr r i (ImmInt (n + off)))
137       Addr r i (ImmInteger n)
138         -> Just (Addr r i (ImmInt (fromInteger (n + toInteger off))))
139       _ -> Nothing
140 #endif
141 #if sparc_TARGET_ARCH
142       AddrRegImm r (ImmInt n)
143        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
144        | otherwise     -> Nothing
145        where n2 = n + off
146
147       AddrRegImm r (ImmInteger n)
148        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
149        | otherwise     -> Nothing
150        where n2 = n + toInteger off
151
152       AddrRegReg r (FixedReg ILIT(0))
153        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
154        | otherwise     -> Nothing
155        
156       _ -> Nothing
157
158 #endif {-sparc-}
159
160 -----------------
161 #if alpha_TARGET_ARCH
162
163 fits8Bits :: Integer -> Bool
164 fits8Bits i = i >= -256 && i < 256
165
166 #endif
167
168 #if sparc_TARGET_ARCH
169 {-# SPECIALIZE
170     fits13Bits :: Int -> Bool
171   #-}
172 {-# SPECIALIZE
173     fits13Bits :: Integer -> Bool
174   #-}
175
176 fits13Bits :: Integral a => a -> Bool
177 fits13Bits x = x >= -4096 && x < 4096
178
179 -----------------
180 largeOffsetError i
181   = error ("ERROR: SPARC native-code generator cannot handle large offset ("++show i++");\nprobably because of large constant data structures;\nworkaround: use -fvia-C on this module.\n")
182
183 #endif {-sparc-}
184 \end{code}
185
186 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
187
188 @stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
189 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
190 The rest are either in real machine registers or stored as offsets
191 from BaseReg.
192
193 \begin{code}
194 data RegLoc = Save StixTree | Always StixTree
195 \end{code}
196
197 Trees for register save locations:
198 \begin{code}
199 saveLoc :: MagicId -> StixTree
200
201 saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
202 \end{code}
203
204 \begin{code}
205 stgReg :: MagicId -> RegLoc
206
207 stgReg x
208   = case (magicIdRegMaybe x) of
209         Just _  -> Save   nonReg
210         Nothing -> Always nonReg
211   where
212     offset = baseRegOffset x
213
214     baseLoc = case (magicIdRegMaybe BaseReg) of
215       Just _  -> StReg (StixMagicId BaseReg)
216       Nothing -> sStLitLbl SLIT("MainRegTable")
217
218     nonReg = case x of
219       StkStubReg        -> sStLitLbl SLIT("STK_STUB_closure")
220       StdUpdRetVecReg   -> sStLitLbl SLIT("vtbl_StdUpdFrame")
221       BaseReg           -> sStLitLbl SLIT("MainRegTable")
222         -- these Hp&HpLim cases perhaps should
223         -- not be here for i386 (???) WDP 96/03
224       Hp                -> StInd PtrRep (sStLitLbl SLIT("StorageMgrInfo"))
225       HpLim             -> StInd PtrRep (sStLitLbl
226                                 (_PK_ ("StorageMgrInfo+" ++ BYTES_PER_WORD_STR)))
227       TagReg            -> StInd IntRep (StPrim IntSubOp [infoptr,
228                                 StInt (1*BYTES_PER_WORD)])
229                         where
230                             r2      = VanillaReg PtrRep ILIT(2)
231                             infoptr = case (stgReg r2) of
232                                           Always t -> t
233                                           Save   _ -> StReg (StixMagicId r2)
234       _ -> StInd (magicIdPrimRep x)
235                  (StPrim IntAddOp [baseLoc,
236                         StInt (toInteger (offset*BYTES_PER_WORD))])
237 \end{code}
238
239 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
240
241 @spRel@ gives us a stack relative addressing mode for volatile
242 temporaries and for excess call arguments.  @fpRel@, where
243 applicable, is the same but for the frame pointer.
244
245 \begin{code}
246 spRel :: Int    -- desired stack offset in words, positive or negative
247       -> Addr
248
249 spRel n
250 #if i386_TARGET_ARCH
251   = Addr (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
252 #else
253   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
254 #endif
255
256 #if sparc_TARGET_ARCH
257 fpRel :: Int -> Addr
258     -- Duznae work for offsets greater than 13 bits; we just hope for
259     -- the best
260 fpRel n
261   = AddrRegImm fp (ImmInt (n * BYTES_PER_WORD))
262 #endif
263 \end{code}
264
265 %************************************************************************
266 %*                                                                      *
267 \subsection[Reg]{Real registers}
268 %*                                                                      *
269 %************************************************************************
270
271 Static Registers correspond to actual machine registers.  These should
272 be avoided until the last possible moment.
273
274 Dynamic registers are allocated on the fly, usually to represent a single
275 value in the abstract assembly code (i.e. dynamic registers are usually
276 single assignment).  Ultimately, they are mapped to available machine
277 registers before spitting out the code.
278
279 \begin{code}
280 data Reg
281   = FixedReg  FAST_INT          -- A pre-allocated machine register
282
283   | MappedReg FAST_INT          -- A dynamically allocated machine register
284
285   | MemoryReg Int PrimRep       -- A machine "register" actually held in
286                                 -- a memory allocated table of
287                                 -- registers which didn't fit in real
288                                 -- registers.
289
290   | UnmappedReg Unique PrimRep  -- One of an infinite supply of registers,
291                                 -- always mapped to one of the earlier
292                                 -- two (?)  before we're done.
293
294 mkReg :: Unique -> PrimRep -> Reg
295 mkReg = UnmappedReg
296
297 getNewRegNCG :: PrimRep -> UniqSM Reg
298 getNewRegNCG pk
299   = getUnique   `thenUs` \ u ->
300     returnUs (UnmappedReg u pk)
301
302 instance Text Reg where
303     showsPrec _ (FixedReg i)    = showString "%"  . shows IBOX(i)
304     showsPrec _ (MappedReg i)   = showString "%"  . shows IBOX(i)
305     showsPrec _ (MemoryReg i _) = showString "%M"  . shows i
306     showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
307
308 #ifdef DEBUG
309 instance Outputable Reg where
310     ppr sty r = ppStr (show r)
311 #endif
312
313 cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
314 cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
315 cmpReg (MemoryReg i _)   (MemoryReg i' _)   = cmp_i i i'
316 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = cmp u u'
317 cmpReg r1 r2
318   = let tag1 = tagReg r1
319         tag2 = tagReg r2
320     in
321         if tag1 _LT_ tag2 then LT_ else GT_
322     where
323         tagReg (FixedReg _)      = (ILIT(1) :: FAST_INT)
324         tagReg (MappedReg _)     = ILIT(2)
325         tagReg (MemoryReg _ _)   = ILIT(3)
326         tagReg (UnmappedReg _ _) = ILIT(4)
327
328 cmp_i :: Int -> Int -> TAG_
329 cmp_i a1 a2 = if a1 == a2 then EQ_ else if a1 < a2 then LT_ else GT_
330
331 cmp_ihash :: FAST_INT -> FAST_INT -> TAG_
332 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ_ else if a1 _LT_ a2 then LT_ else GT_
333
334 instance Eq Reg where
335     a == b = case cmpReg a b of { EQ_ -> True;  _ -> False }
336     a /= b = case cmpReg a b of { EQ_ -> False; _ -> True  }
337
338 instance Ord Reg where
339     a <= b = case cmpReg a b of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
340     a <  b = case cmpReg a b of { LT_ -> True;  EQ_ -> False; GT__ -> False }
341     a >= b = case cmpReg a b of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
342     a >  b = case cmpReg a b of { LT_ -> False; EQ_ -> False; GT__ -> True  }
343     _tagCmp a b = case cmpReg a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
344
345 instance Uniquable Reg where
346     uniqueOf (UnmappedReg u _) = u
347     uniqueOf (FixedReg i)      = mkPseudoUnique1 IBOX(i)
348     uniqueOf (MappedReg i)     = mkPseudoUnique2 IBOX(i)
349     uniqueOf (MemoryReg i _)   = mkPseudoUnique3 i
350 \end{code}
351
352 \begin{code}
353 type RegNo = Int
354
355 realReg :: RegNo -> Reg
356 realReg n@IBOX(i)
357   = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
358
359 extractMappedRegNos :: [Reg] -> [RegNo]
360
361 extractMappedRegNos regs
362   = foldr ex [] regs
363   where
364     ex (MappedReg i) acc = IBOX(i) : acc  -- we'll take it
365     ex _             acc = acc            -- leave it out
366 \end{code}
367
368 ** Machine-specific Reg stuff: **
369
370 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
371 point registers.  The mapping of STG registers to alpha machine registers
372 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
373 \begin{code}
374 #if alpha_TARGET_ARCH
375 fReg :: Int -> Int
376 fReg x = (32 + x)
377
378 v0, f0, ra, pv, gp, sp, zero :: Reg
379 v0   = realReg 0
380 f0   = realReg (fReg 0)
381 ra   = FixedReg ILIT(26)
382 pv   = t12
383 gp   = FixedReg ILIT(29)
384 sp   = FixedReg ILIT(30)
385 zero = FixedReg ILIT(31)
386
387 t9, t10, t11, t12 :: Reg
388 t9  = realReg 23
389 t10 = realReg 24
390 t11 = realReg 25
391 t12 = realReg 27
392 #endif
393 \end{code}
394
395 Intel x86 architecture:
396 - All registers except 7 (esp) are available for use.
397 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
398 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
399 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
400 - Registers 8-15 hold extended floating point values.
401 \begin{code}
402 #if i386_TARGET_ARCH
403
404 gReg,fReg :: Int -> Int
405 gReg x = x
406 fReg x = (8 + x)
407
408 st0, st1, st2, st3, st4, st5, st6, st7, eax, ebx, ecx, edx, esp :: Reg
409 eax = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
410 ebx = case (gReg 1) of { IBOX(g1) -> FixedReg g1 }
411 ecx = case (gReg 2) of { IBOX(g2) -> FixedReg g2 }
412 edx = case (gReg 3) of { IBOX(g3) -> FixedReg g3 }
413 esi = case (gReg 4) of { IBOX(g4) -> FixedReg g4 }
414 edi = case (gReg 5) of { IBOX(g5) -> FixedReg g5 }
415 ebp = case (gReg 6) of { IBOX(g6) -> FixedReg g6 }
416 esp = case (gReg 7) of { IBOX(g7) -> FixedReg g7 }
417 st0 = realReg  (fReg 0)
418 st1 = realReg  (fReg 1)
419 st2 = realReg  (fReg 2)
420 st3 = realReg  (fReg 3)
421 st4 = realReg  (fReg 4)
422 st5 = realReg  (fReg 5)
423 st6 = realReg  (fReg 6)
424 st7 = realReg  (fReg 7)
425
426 #endif
427 \end{code}
428
429 The SPARC has 64 registers of interest; 32 integer registers and 32
430 floating point registers.  The mapping of STG registers to SPARC
431 machine registers is defined in StgRegs.h.  We are, of course,
432 prepared for any eventuality.
433
434 \begin{code}
435 #if sparc_TARGET_ARCH
436
437 gReg,lReg,iReg,oReg,fReg :: Int -> Int
438 gReg x = x
439 oReg x = (8 + x)
440 lReg x = (16 + x)
441 iReg x = (24 + x)
442 fReg x = (32 + x)
443
444 fPair :: Reg -> Reg
445 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
446 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
447
448 g0, fp, sp, o0, f0 :: Reg
449 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
450 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
451 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
452 o0 = realReg  (oReg 0)
453 f0 = realReg  (fReg 0)
454
455 #endif
456 \end{code}
457
458 Redefine the literals used for machine-registers with non-numeric
459 names in the header files.  Gag me with a spoon, eh?
460 \begin{code}
461 #if alpha_TARGET_ARCH
462 #define f0 32
463 #define f1 33
464 #define f2 34
465 #define f3 35
466 #define f4 36
467 #define f5 37
468 #define f6 38
469 #define f7 39
470 #define f8 40
471 #define f9 41
472 #define f10 42
473 #define f11 43
474 #define f12 44
475 #define f13 45
476 #define f14 46
477 #define f15 47
478 #define f16 48
479 #define f17 49
480 #define f18 50
481 #define f19 51
482 #define f20 52
483 #define f21 53
484 #define f22 54
485 #define f23 55
486 #define f24 56
487 #define f25 57
488 #define f26 58
489 #define f27 59
490 #define f28 60
491 #define f29 61
492 #define f30 62
493 #define f31 63
494 #endif
495 #if i386_TARGET_ARCH
496 #define eax 0
497 #define ebx 1
498 #define ecx 2
499 #define edx 3
500 #define esi 4
501 #define edi 5
502 #define ebp 6
503 #define esp 7
504 #define st0 8
505 #define st1 9
506 #define st2 10
507 #define st3 11
508 #define st4 12
509 #define st5 13
510 #define st6 14
511 #define st7 15
512 #endif
513 #if sparc_TARGET_ARCH
514 #define g0 0
515 #define g1 1
516 #define g2 2
517 #define g3 3
518 #define g4 4
519 #define g5 5
520 #define g6 6
521 #define g7 7
522 #define o0 8
523 #define o1 9
524 #define o2 10
525 #define o3 11
526 #define o4 12
527 #define o5 13
528 #define o6 14
529 #define o7 15
530 #define l0 16
531 #define l1 17
532 #define l2 18
533 #define l3 19
534 #define l4 20
535 #define l5 21
536 #define l6 22
537 #define l7 23
538 #define i0 24
539 #define i1 25
540 #define i2 26
541 #define i3 27
542 #define i4 28
543 #define i5 29
544 #define i6 30
545 #define i7 31
546 #define f0 32
547 #define f1 33
548 #define f2 34
549 #define f3 35
550 #define f4 36
551 #define f5 37
552 #define f6 38
553 #define f7 39
554 #define f8 40
555 #define f9 41
556 #define f10 42
557 #define f11 43
558 #define f12 44
559 #define f13 45
560 #define f14 46
561 #define f15 47
562 #define f16 48
563 #define f17 49
564 #define f18 50
565 #define f19 51
566 #define f20 52
567 #define f21 53
568 #define f22 54
569 #define f23 55
570 #define f24 56
571 #define f25 57
572 #define f26 58
573 #define f27 59
574 #define f28 60
575 #define f29 61
576 #define f30 62
577 #define f31 63
578 #endif
579 \end{code}
580
581 \begin{code}
582 baseRegOffset :: MagicId -> Int
583
584 baseRegOffset StkOReg                = OFFSET_StkO
585 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
586 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
587 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
588 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
589 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
590 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
591 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
592 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
593 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_Flt1
594 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_Flt2
595 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_Flt3
596 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_Flt4
597 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_Dbl1
598 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_Dbl2
599 baseRegOffset TagReg                 = OFFSET_Tag
600 baseRegOffset RetReg                 = OFFSET_Ret
601 baseRegOffset SpA                    = OFFSET_SpA
602 baseRegOffset SuA                    = OFFSET_SuA
603 baseRegOffset SpB                    = OFFSET_SpB
604 baseRegOffset SuB                    = OFFSET_SuB
605 baseRegOffset Hp                     = OFFSET_Hp
606 baseRegOffset HpLim                  = OFFSET_HpLim
607 baseRegOffset LivenessReg            = OFFSET_Liveness
608 #ifdef DEBUG
609 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
610 baseRegOffset StdUpdRetVecReg        = panic "baseRegOffset:StgUpdRetVecReg"
611 baseRegOffset StkStubReg             = panic "baseRegOffset:StkStubReg"
612 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
613 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
614 #endif
615 \end{code}
616
617 \begin{code}
618 callerSaves :: MagicId -> Bool
619
620 #ifdef CALLER_SAVES_Base
621 callerSaves BaseReg                     = True
622 #endif
623 #ifdef CALLER_SAVES_StkO
624 callerSaves StkOReg                     = True
625 #endif
626 #ifdef CALLER_SAVES_R1
627 callerSaves (VanillaReg _ ILIT(1))      = True
628 #endif
629 #ifdef CALLER_SAVES_R2
630 callerSaves (VanillaReg _ ILIT(2))      = True
631 #endif
632 #ifdef CALLER_SAVES_R3
633 callerSaves (VanillaReg _ ILIT(3))      = True
634 #endif
635 #ifdef CALLER_SAVES_R4
636 callerSaves (VanillaReg _ ILIT(4))      = True
637 #endif
638 #ifdef CALLER_SAVES_R5
639 callerSaves (VanillaReg _ ILIT(5))      = True
640 #endif
641 #ifdef CALLER_SAVES_R6
642 callerSaves (VanillaReg _ ILIT(6))      = True
643 #endif
644 #ifdef CALLER_SAVES_R7
645 callerSaves (VanillaReg _ ILIT(7))      = True
646 #endif
647 #ifdef CALLER_SAVES_R8
648 callerSaves (VanillaReg _ ILIT(8))      = True
649 #endif
650 #ifdef CALLER_SAVES_FltReg1
651 callerSaves (FloatReg ILIT(1))          = True
652 #endif
653 #ifdef CALLER_SAVES_FltReg2
654 callerSaves (FloatReg ILIT(2))          = True
655 #endif
656 #ifdef CALLER_SAVES_FltReg3
657 callerSaves (FloatReg ILIT(3))          = True
658 #endif
659 #ifdef CALLER_SAVES_FltReg4
660 callerSaves (FloatReg ILIT(4))          = True
661 #endif
662 #ifdef CALLER_SAVES_DblReg1
663 callerSaves (DoubleReg ILIT(1))         = True
664 #endif
665 #ifdef CALLER_SAVES_DblReg2
666 callerSaves (DoubleReg ILIT(2))         = True
667 #endif
668 #ifdef CALLER_SAVES_Tag
669 callerSaves TagReg                      = True
670 #endif
671 #ifdef CALLER_SAVES_Ret
672 callerSaves RetReg                      = True
673 #endif
674 #ifdef CALLER_SAVES_SpA
675 callerSaves SpA                         = True
676 #endif
677 #ifdef CALLER_SAVES_SuA
678 callerSaves SuA                         = True
679 #endif
680 #ifdef CALLER_SAVES_SpB
681 callerSaves SpB                         = True
682 #endif
683 #ifdef CALLER_SAVES_SuB
684 callerSaves SuB                         = True
685 #endif
686 #ifdef CALLER_SAVES_Hp
687 callerSaves Hp                          = True
688 #endif
689 #ifdef CALLER_SAVES_HpLim
690 callerSaves HpLim                       = True
691 #endif
692 #ifdef CALLER_SAVES_Liveness
693 callerSaves LivenessReg                 = True
694 #endif
695 #ifdef CALLER_SAVES_StdUpdRetVec
696 callerSaves StdUpdRetVecReg             = True
697 #endif
698 #ifdef CALLER_SAVES_StkStub
699 callerSaves StkStubReg                  = True
700 #endif
701 callerSaves _                           = False
702 \end{code}
703
704 \begin{code}
705 magicIdRegMaybe :: MagicId -> Maybe Reg
706
707 #ifdef REG_Base
708 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
709 #endif
710 #ifdef REG_StkO
711 magicIdRegMaybe StkOReg                 = Just (FixedReg ILIT(REG_StkOReg))
712 #endif
713 #ifdef REG_R1
714 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
715 #endif 
716 #ifdef REG_R2 
717 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
718 #endif 
719 #ifdef REG_R3 
720 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
721 #endif 
722 #ifdef REG_R4 
723 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
724 #endif 
725 #ifdef REG_R5 
726 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
727 #endif 
728 #ifdef REG_R6 
729 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
730 #endif 
731 #ifdef REG_R7 
732 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
733 #endif 
734 #ifdef REG_R8 
735 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
736 #endif
737 #ifdef REG_Flt1
738 magicIdRegMaybe (FloatReg ILIT(1))      = Just (FixedReg ILIT(REG_Flt1))
739 #endif                                  
740 #ifdef REG_Flt2                         
741 magicIdRegMaybe (FloatReg ILIT(2))      = Just (FixedReg ILIT(REG_Flt2))
742 #endif                                  
743 #ifdef REG_Flt3                         
744 magicIdRegMaybe (FloatReg ILIT(3))      = Just (FixedReg ILIT(REG_Flt3))
745 #endif                                  
746 #ifdef REG_Flt4                         
747 magicIdRegMaybe (FloatReg ILIT(4))      = Just (FixedReg ILIT(REG_Flt4))
748 #endif                                  
749 #ifdef REG_Dbl1                         
750 magicIdRegMaybe (DoubleReg ILIT(1))     = Just (FixedReg ILIT(REG_Dbl1))
751 #endif                                  
752 #ifdef REG_Dbl2                         
753 magicIdRegMaybe (DoubleReg ILIT(2))     = Just (FixedReg ILIT(REG_Dbl2))
754 #endif
755 #ifdef REG_Tag
756 magicIdRegMaybe TagReg                  = Just (FixedReg ILIT(REG_TagReg))
757 #endif      
758 #ifdef REG_Ret      
759 magicIdRegMaybe RetReg                  = Just (FixedReg ILIT(REG_Ret))
760 #endif      
761 #ifdef REG_SpA      
762 magicIdRegMaybe SpA                     = Just (FixedReg ILIT(REG_SpA))
763 #endif                                  
764 #ifdef REG_SuA                          
765 magicIdRegMaybe SuA                     = Just (FixedReg ILIT(REG_SuA))
766 #endif                                  
767 #ifdef REG_SpB                          
768 magicIdRegMaybe SpB                     = Just (FixedReg ILIT(REG_SpB))
769 #endif                                  
770 #ifdef REG_SuB                          
771 magicIdRegMaybe SuB                     = Just (FixedReg ILIT(REG_SuB))
772 #endif                                  
773 #ifdef REG_Hp                           
774 magicIdRegMaybe Hp                      = Just (FixedReg ILIT(REG_Hp))
775 #endif                                  
776 #ifdef REG_HpLim                        
777 magicIdRegMaybe HpLim                   = Just (FixedReg ILIT(REG_HpLim))
778 #endif                                  
779 #ifdef REG_Liveness                     
780 magicIdRegMaybe LivenessReg             = Just (FixedReg ILIT(REG_Liveness))
781 #endif                                  
782 #ifdef REG_StdUpdRetVec                 
783 magicIdRegMaybe StdUpdRetVecReg         = Just (FixedReg ILIT(REG_StdUpdRetVec))
784 #endif                                  
785 #ifdef REG_StkStub                      
786 magicIdRegMaybe StkStubReg              = Just (FixedReg ILIT(REG_StkStub))
787 #endif                                  
788 magicIdRegMaybe _                       = Nothing
789 \end{code}
790
791 %************************************************************************
792 %*                                                                      *
793 \subsection{Free, reserved, call-clobbered, and argument registers}
794 %*                                                                      *
795 %************************************************************************
796
797 @freeRegs@ is the list of registers we can use in register allocation.
798 @freeReg@ (below) says if a particular register is free.
799
800 With a per-instruction clobber list, we might be able to get some of
801 these back, but it's probably not worth the hassle.
802
803 @callClobberedRegs@ ... the obvious.
804
805 @argRegs@: assuming a call with N arguments, what registers will be
806 used to hold arguments?  (NB: it doesn't know whether the arguments
807 are integer or floating-point...)
808
809 \begin{code}
810 reservedRegs :: [RegNo]
811 reservedRegs
812 #if alpha_TARGET_ARCH
813   = [NCG_Reserved_I1, NCG_Reserved_I2,
814      NCG_Reserved_F1, NCG_Reserved_F2]
815 #endif
816 #if i386_TARGET_ARCH
817   = [{-certainly cannot afford any!-}]
818 #endif
819 #if sparc_TARGET_ARCH
820   = [NCG_Reserved_I1, NCG_Reserved_I2,
821      NCG_Reserved_F1, NCG_Reserved_F2,
822      NCG_Reserved_D1, NCG_Reserved_D2]
823 #endif
824
825 -------------------------------
826 freeRegs :: [Reg]
827 freeRegs
828   = freeMappedRegs IF_ARCH_alpha( [0..63],
829                    IF_ARCH_i386(  [0..15],
830                    IF_ARCH_sparc( [0..63],)))
831
832 -------------------------------
833 callClobberedRegs :: [Reg]
834 callClobberedRegs
835   = freeMappedRegs
836 #if alpha_TARGET_ARCH
837     [0, 1, 2, 3, 4, 5, 6, 7, 8,
838      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
839      fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
840      fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
841      fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
842 #endif {- alpha_TARGET_ARCH -}
843 #if i386_TARGET_ARCH
844     [{-none-}]
845 #endif {- i386_TARGET_ARCH -}
846 #if sparc_TARGET_ARCH
847     ( oReg 7 :
848       [oReg i | i <- [0..5]] ++
849       [gReg i | i <- [1..7]] ++
850       [fReg i | i <- [0..31]] )
851 #endif {- sparc_TARGET_ARCH -}
852
853 -------------------------------
854 argRegs :: Int -> [Reg]
855
856 argRegs 0 = []
857 #if alpha_TARGET_ARCH
858 argRegs 1 = freeMappedRegs [16, fReg 16]
859 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
860 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
861 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
862 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
863 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
864 #endif {- alpha_TARGET_ARCH -}
865 #if i386_TARGET_ARCH
866 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
867 #endif {- i386_TARGET_ARCH -}
868 #if sparc_TARGET_ARCH
869 argRegs 1 = freeMappedRegs (map oReg [0])
870 argRegs 2 = freeMappedRegs (map oReg [0,1])
871 argRegs 3 = freeMappedRegs (map oReg [0,1,2])
872 argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
873 argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
874 argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
875 #endif {- sparc_TARGET_ARCH -}
876 argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
877
878 -------------------------------
879
880 #if alpha_TARGET_ARCH
881 allArgRegs :: [(Reg, Reg)]
882
883 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
884 #endif {- alpha_TARGET_ARCH -}
885
886 #if sparc_TARGET_ARCH
887 allArgRegs :: [Reg]
888
889 allArgRegs = map realReg [oReg i | i <- [0..5]]
890 #endif {- sparc_TARGET_ARCH -}
891
892 -------------------------------
893 freeMappedRegs :: [Int] -> [Reg]
894
895 freeMappedRegs nums
896   = foldr free [] nums
897   where
898     free IBOX(i) acc
899       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
900 \end{code}
901
902 \begin{code}
903 freeReg :: FAST_INT -> FAST_BOOL
904
905 #if alpha_TARGET_ARCH
906 freeReg ILIT(26) = _FALSE_  -- return address (ra)
907 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
908 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
909 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
910 freeReg ILIT(31) = _FALSE_  -- always zero (zero)
911 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
912 #endif
913
914 #if i386_TARGET_ARCH
915 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
916 #endif
917
918 #if sparc_TARGET_ARCH
919 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
920 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
921 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
922 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
923 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
924 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
925 #endif
926
927 #ifdef REG_Base
928 freeReg ILIT(REG_Base) = _FALSE_
929 #endif
930 #ifdef REG_StkO
931 freeReg ILIT(REG_StkO) = _FALSE_
932 #endif
933 #ifdef REG_R1
934 freeReg ILIT(REG_R1)   = _FALSE_
935 #endif  
936 #ifdef REG_R2  
937 freeReg ILIT(REG_R2)   = _FALSE_
938 #endif  
939 #ifdef REG_R3  
940 freeReg ILIT(REG_R3)   = _FALSE_
941 #endif  
942 #ifdef REG_R4  
943 freeReg ILIT(REG_R4)   = _FALSE_
944 #endif  
945 #ifdef REG_R5  
946 freeReg ILIT(REG_R5)   = _FALSE_
947 #endif  
948 #ifdef REG_R6  
949 freeReg ILIT(REG_R6)   = _FALSE_
950 #endif  
951 #ifdef REG_R7  
952 freeReg ILIT(REG_R7)   = _FALSE_
953 #endif  
954 #ifdef REG_R8  
955 freeReg ILIT(REG_R8)   = _FALSE_
956 #endif
957 #ifdef REG_Flt1
958 freeReg ILIT(REG_Flt1) = _FALSE_
959 #endif
960 #ifdef REG_Flt2
961 freeReg ILIT(REG_Flt2) = _FALSE_
962 #endif
963 #ifdef REG_Flt3
964 freeReg ILIT(REG_Flt3) = _FALSE_
965 #endif
966 #ifdef REG_Flt4
967 freeReg ILIT(REG_Flt4) = _FALSE_
968 #endif
969 #ifdef REG_Dbl1
970 freeReg ILIT(REG_Dbl1) = _FALSE_
971 #endif
972 #ifdef REG_Dbl2
973 freeReg ILIT(REG_Dbl2) = _FALSE_
974 #endif
975 #ifdef REG_Tag
976 freeReg ILIT(REG_Tag)  = _FALSE_
977 #endif 
978 #ifdef REG_Ret 
979 freeReg ILIT(REG_Ret)  = _FALSE_
980 #endif 
981 #ifdef REG_SpA 
982 freeReg ILIT(REG_SpA)  = _FALSE_
983 #endif 
984 #ifdef REG_SuA 
985 freeReg ILIT(REG_SuA)  = _FALSE_
986 #endif 
987 #ifdef REG_SpB 
988 freeReg ILIT(REG_SpB)  = _FALSE_
989 #endif 
990 #ifdef REG_SuB 
991 freeReg ILIT(REG_SuB)  = _FALSE_
992 #endif 
993 #ifdef REG_Hp 
994 freeReg ILIT(REG_Hp)   = _FALSE_
995 #endif
996 #ifdef REG_HpLim
997 freeReg ILIT(REG_HpLim) = _FALSE_
998 #endif
999 #ifdef REG_Liveness
1000 freeReg ILIT(REG_Liveness) = _FALSE_
1001 #endif
1002 #ifdef REG_StdUpdRetVec
1003 freeReg ILIT(REG_StdUpdRetVec) = _FALSE_
1004 #endif
1005 #ifdef REG_StkStub
1006 freeReg ILIT(REG_StkStub) = _FALSE_
1007 #endif
1008 freeReg _ = _TRUE_
1009 freeReg n
1010   -- we hang onto two double regs for dedicated
1011   -- use; this is not necessary on Alphas and
1012   -- may not be on other non-SPARCs.
1013 #ifdef REG_Dbl1
1014   | n _EQ_ (ILIT(REG_Dbl1) _ADD_ ILIT(1)) = _FALSE_
1015 #endif
1016 #ifdef REG_Dbl2
1017   | n _EQ_ (ILIT(REG_Dbl2) _ADD_ ILIT(1)) = _FALSE_
1018 #endif
1019   | otherwise = _TRUE_
1020 \end{code}