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