[project @ 2000-02-28 12:02:31 by sewardj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachRegs.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1996-1998
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 "nativeGen/NCG.h"
14
15 module MachRegs (
16
17         Reg(..),
18         Imm(..),
19         MachRegsAddr(..),
20         RegLoc(..),
21         RegNo,
22
23         addrOffset,
24         argRegs,
25         baseRegOffset,
26         callClobberedRegs,
27         callerSaves,
28         extractMappedRegNos,
29         mappedRegNo,
30         freeMappedRegs,
31         freeReg, freeRegs,
32         getNewRegNCG,
33         magicIdRegMaybe,
34         mkReg,
35         realReg,
36         saveLoc,
37         spRel,
38         stgReg,
39         strImmLit
40
41 #if alpha_TARGET_ARCH
42         , allArgRegs
43         , fits8Bits
44         , fReg
45         , gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
46 #endif
47 #if i386_TARGET_ARCH
48         , eax, ebx, ecx, edx, esi, esp
49         , fake0, fake1, fake2, fake3, fake4, fake5
50 #endif
51 #if sparc_TARGET_ARCH
52         , allArgRegs
53         , fits13Bits
54         , fPair, fpRel, gReg, iReg, lReg, oReg, largeOffsetError
55         , fp, g0, o0, f0
56         
57 #endif
58     ) where
59
60 #include "HsVersions.h"
61
62 import AbsCSyn          ( MagicId(..) )
63 import AbsCUtils        ( magicIdPrimRep )
64 import CLabel           ( CLabel )
65 import PrimOp           ( PrimOp(..) )
66 import PrimRep          ( PrimRep(..) )
67 import Stix             ( sStLitLbl, StixTree(..), StixReg(..),
68                           getUniqueNat, returnNat, thenNat, NatM )
69 import Unique           ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
70                           Uniquable(..), Unique
71                         )
72 --import UniqSupply     ( getUniqueUs, returnUs, thenUs, UniqSM )
73 import Outputable
74 \end{code}
75
76 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
77
78 \begin{code}
79 data Imm
80   = ImmInt      Int
81   | ImmInteger  Integer     -- Sigh.
82   | ImmCLbl     CLabel      -- AbstractC Label (with baggage)
83   | ImmLab      SDoc    -- Simple string label (underscore-able)
84   | ImmLit      SDoc    -- Simple string
85   | ImmIndex    CLabel Int
86   | ImmDouble   Rational
87   IF_ARCH_sparc(
88   | LO Imm                  -- Possible restrictions...
89   | HI Imm
90   ,)
91 strImmLit s = ImmLit (text s)
92 \end{code}
93
94 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
95
96 \begin{code}
97 data MachRegsAddr
98 #if alpha_TARGET_ARCH
99   = AddrImm     Imm
100   | AddrReg     Reg
101   | AddrRegImm  Reg Imm
102 #endif
103
104 #if i386_TARGET_ARCH
105   = AddrBaseIndex       Base Index Displacement
106   | ImmAddr             Imm Int
107
108 type Base         = Maybe Reg
109 type Index        = Maybe (Reg, Int)    -- Int is 2, 4 or 8
110 type Displacement = Imm
111 #endif
112
113 #if sparc_TARGET_ARCH
114   = AddrRegReg  Reg Reg
115   | AddrRegImm  Reg Imm
116 #endif
117
118 addrOffset :: MachRegsAddr -> Int -> Maybe MachRegsAddr
119
120 addrOffset addr off
121   = case addr of
122 #if alpha_TARGET_ARCH
123       _ -> panic "MachMisc.addrOffset not defined for Alpha"
124 #endif
125 #if i386_TARGET_ARCH
126       ImmAddr i off0      -> Just (ImmAddr i (off0 + off))
127       AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
128       AddrBaseIndex r i (ImmInteger n)
129         -> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
130       _ -> Nothing
131 #endif
132 #if sparc_TARGET_ARCH
133       AddrRegImm r (ImmInt n)
134        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
135        | otherwise     -> Nothing
136        where n2 = n + off
137
138       AddrRegImm r (ImmInteger n)
139        | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
140        | otherwise     -> Nothing
141        where n2 = n + toInteger off
142
143       AddrRegReg r (FixedReg ILIT(0))
144        | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
145        | otherwise     -> Nothing
146        
147       _ -> Nothing
148
149 #endif {-sparc-}
150
151 -----------------
152 #if alpha_TARGET_ARCH
153
154 fits8Bits :: Integer -> Bool
155 fits8Bits i = i >= -256 && i < 256
156
157 #endif
158
159 #if sparc_TARGET_ARCH
160 {-# SPECIALIZE
161     fits13Bits :: Int -> Bool
162   #-}
163 {-# SPECIALIZE
164     fits13Bits :: Integer -> Bool
165   #-}
166
167 fits13Bits :: Integral a => a -> Bool
168 fits13Bits x = x >= -4096 && x < 4096
169
170 -----------------
171 largeOffsetError i
172   = 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")
173
174 #endif {-sparc-}
175 \end{code}
176
177 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
178
179 @stgReg@: we map STG registers onto appropriate Stix Trees.  First, we
180 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
181 The rest are either in real machine registers or stored as offsets
182 from BaseReg.
183
184 \begin{code}
185 data RegLoc = Save StixTree | Always StixTree
186 \end{code}
187
188 Trees for register save locations:
189 \begin{code}
190 saveLoc :: MagicId -> StixTree
191
192 saveLoc reg = case (stgReg reg) of {Always loc -> loc; Save loc -> loc}
193 \end{code}
194
195 \begin{code}
196 stgReg :: MagicId -> RegLoc
197
198 stgReg x
199   = case (magicIdRegMaybe x) of
200         Just _  -> Save   nonReg
201         Nothing -> Always nonReg
202   where
203     offset = baseRegOffset x
204
205     baseLoc = case (magicIdRegMaybe BaseReg) of
206       Just _  -> StReg (StixMagicId BaseReg)
207       Nothing -> sStLitLbl SLIT("MainRegTable")
208
209     nonReg = case x of
210       BaseReg           -> sStLitLbl SLIT("MainRegTable")
211
212       _ -> StInd (magicIdPrimRep x)
213                  (StPrim IntAddOp [baseLoc,
214                         StInt (toInteger (offset*BYTES_PER_WORD))])
215 \end{code}
216
217 % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
218
219 @spRel@ gives us a stack relative addressing mode for volatile
220 temporaries and for excess call arguments.  @fpRel@, where
221 applicable, is the same but for the frame pointer.
222
223 \begin{code}
224 spRel :: Int    -- desired stack offset in words, positive or negative
225       -> MachRegsAddr
226
227 spRel n
228 #if i386_TARGET_ARCH
229   = AddrBaseIndex (Just esp) Nothing (ImmInt (n * BYTES_PER_WORD))
230 #else
231   = AddrRegImm sp (ImmInt (n * BYTES_PER_WORD))
232 #endif
233
234 #if sparc_TARGET_ARCH
235 fpRel :: Int -> MachRegsAddr
236     -- Duznae work for offsets greater than 13 bits; we just hope for
237     -- the best
238 fpRel n
239   = AddrRegImm fp (ImmInt (n * BYTES_PER_WORD))
240 #endif
241 \end{code}
242
243 %************************************************************************
244 %*                                                                      *
245 \subsection[Reg]{Real registers}
246 %*                                                                      *
247 %************************************************************************
248
249 Static Registers correspond to actual machine registers.  These should
250 be avoided until the last possible moment.
251
252 Dynamic registers are allocated on the fly, usually to represent a single
253 value in the abstract assembly code (i.e. dynamic registers are usually
254 single assignment).  Ultimately, they are mapped to available machine
255 registers before spitting out the code.
256
257 \begin{code}
258 data Reg
259   = FixedReg  FAST_INT          -- A pre-allocated machine register
260
261   | MappedReg FAST_INT          -- A dynamically allocated machine register
262
263   | MemoryReg Int PrimRep       -- A machine "register" actually held in
264                                 -- a memory allocated table of
265                                 -- registers which didn't fit in real
266                                 -- registers.
267
268   | UnmappedReg Unique PrimRep  -- One of an infinite supply of registers,
269                                 -- always mapped to one of the earlier
270                                 -- two (?)  before we're done.
271 mkReg :: Unique -> PrimRep -> Reg
272 mkReg = UnmappedReg
273
274 getNewRegNCG :: PrimRep -> NatM Reg
275 getNewRegNCG pk
276   = getUniqueNat `thenNat` \ u ->
277     returnNat (UnmappedReg u pk)
278
279 instance Text Reg where
280     showsPrec _ (FixedReg i)    = showString "%"  . shows IBOX(i)
281     showsPrec _ (MappedReg i)   = showString "%"  . shows IBOX(i)
282     showsPrec _ (MemoryReg i _) = showString "%M"  . shows i
283     showsPrec _ (UnmappedReg i _) = showString "%U" . shows i
284
285 #ifdef DEBUG
286 instance Outputable Reg where
287     ppr r = text (show r)
288 #endif
289
290 cmpReg (FixedReg i)      (FixedReg i')      = cmp_ihash i i'
291 cmpReg (MappedReg i)     (MappedReg i')     = cmp_ihash i i'
292 cmpReg (MemoryReg i _)   (MemoryReg i' _)   = i `compare` i'
293 cmpReg (UnmappedReg u _) (UnmappedReg u' _) = compare u u'
294 cmpReg r1 r2
295   = let tag1 = tagReg r1
296         tag2 = tagReg r2
297     in
298         if tag1 _LT_ tag2 then LT else GT
299     where
300         tagReg (FixedReg _)      = (ILIT(1) :: FAST_INT)
301         tagReg (MappedReg _)     = ILIT(2)
302         tagReg (MemoryReg _ _)   = ILIT(3)
303         tagReg (UnmappedReg _ _) = ILIT(4)
304
305 cmp_ihash :: FAST_INT -> FAST_INT -> Ordering
306 cmp_ihash a1 a2 = if a1 _EQ_ a2 then EQ else if a1 _LT_ a2 then LT else GT
307
308 instance Eq Reg where
309     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
310     a /= b = case (a `compare` b) of { EQ -> False; _ -> True  }
311
312 instance Ord Reg where
313     a <= b = case (a `compare` b) of { LT -> True;      EQ -> True;  GT -> False }
314     a <  b = case (a `compare` b) of { LT -> True;      EQ -> False; GT -> False }
315     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
316     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
317     compare a b = cmpReg a b
318
319 instance Uniquable Reg where
320     getUnique (UnmappedReg u _) = u
321     getUnique (FixedReg i)      = mkPseudoUnique1 IBOX(i)
322     getUnique (MappedReg i)     = mkPseudoUnique2 IBOX(i)
323     getUnique (MemoryReg i _)   = mkPseudoUnique3 i
324 \end{code}
325
326 \begin{code}
327 type RegNo = Int
328
329 realReg :: RegNo -> Reg
330 realReg n@IBOX(i)
331   = if _IS_TRUE_(freeReg i) then MappedReg i else FixedReg i
332
333 extractMappedRegNos :: [Reg] -> [RegNo]
334
335 extractMappedRegNos regs
336   = foldr ex [] regs
337   where
338     ex (MappedReg i) acc = IBOX(i) : acc  -- we'll take it
339     ex _             acc = acc            -- leave it out
340
341 mappedRegNo :: Reg -> RegNo
342 mappedRegNo (MappedReg i) = IBOX(i)
343 mappedRegNo _             = pprPanic "mappedRegNo" empty
344 \end{code}
345
346 ** Machine-specific Reg stuff: **
347
348 The Alpha has 64 registers of interest; 32 integer registers and 32 floating
349 point registers.  The mapping of STG registers to alpha machine registers
350 is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
351 \begin{code}
352 #if alpha_TARGET_ARCH
353 fReg :: Int -> Int
354 fReg x = (32 + x)
355
356 v0, f0, ra, pv, gp, sp, zeroh :: Reg
357 v0    = realReg 0
358 f0    = realReg (fReg 0)
359 ra    = FixedReg ILIT(26)
360 pv    = t12
361 gp    = FixedReg ILIT(29)
362 sp    = FixedReg ILIT(30)
363 zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
364
365 t9, t10, t11, t12 :: Reg
366 t9  = realReg 23
367 t10 = realReg 24
368 t11 = realReg 25
369 t12 = realReg 27
370 #endif
371 \end{code}
372
373 Intel x86 architecture:
374 - All registers except 7 (esp) are available for use.
375 - Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
376 - Registers 0-7 have 16-bit counterparts (ax, bx etc.)
377 - Registers 0-3 have 8 bit counterparts (ah, bh etc.)
378 - Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
379   fp registers, and 3-operand insns for them, and we translate this into
380   real stack-based x86 fp code after register allocation.
381
382 \begin{code}
383 #if i386_TARGET_ARCH
384
385 gReg,fReg :: Int -> Int
386 gReg x = x
387 fReg x = (8 + x)
388
389 fake0, fake1, fake2, fake3, fake4, fake5, eax, ebx, ecx, edx, esp :: Reg
390 eax = realReg (gReg 0)
391 ebx = realReg (gReg 1)
392 ecx = realReg (gReg 2)
393 edx = realReg (gReg 3)
394 esi = realReg (gReg 4)
395 edi = realReg (gReg 5)
396 ebp = realReg (gReg 6)
397 esp = realReg (gReg 7)
398 fake0 = realReg (fReg 0)
399 fake1 = realReg (fReg 1)
400 fake2 = realReg (fReg 2)
401 fake3 = realReg (fReg 3)
402 fake4 = realReg (fReg 4)
403 fake5 = realReg (fReg 5)
404 #endif
405 \end{code}
406
407 The SPARC has 64 registers of interest; 32 integer registers and 32
408 floating point registers.  The mapping of STG registers to SPARC
409 machine registers is defined in StgRegs.h.  We are, of course,
410 prepared for any eventuality.
411
412 \begin{code}
413 #if sparc_TARGET_ARCH
414
415 gReg,lReg,iReg,oReg,fReg :: Int -> Int
416 gReg x = x
417 oReg x = (8 + x)
418 lReg x = (16 + x)
419 iReg x = (24 + x)
420 fReg x = (32 + x)
421
422 fPair :: Reg -> Reg
423 fPair (FixedReg i) = FixedReg (i _ADD_ ILIT(1))
424 fPair (MappedReg i) = MappedReg (i _ADD_ ILIT(1))
425
426 g0, fp, sp, o0, f0 :: Reg
427 g0 = case (gReg 0) of { IBOX(g0) -> FixedReg g0 }
428 fp = case (iReg 6) of { IBOX(i6) -> FixedReg i6 }
429 sp = case (oReg 6) of { IBOX(o6) -> FixedReg o6 }
430 o0 = realReg  (oReg 0)
431 f0 = realReg  (fReg 0)
432
433 #endif
434 \end{code}
435
436 Redefine the literals used for machine-registers with non-numeric
437 names in the header files.  Gag me with a spoon, eh?
438 \begin{code}
439 #if alpha_TARGET_ARCH
440 #define f0 32
441 #define f1 33
442 #define f2 34
443 #define f3 35
444 #define f4 36
445 #define f5 37
446 #define f6 38
447 #define f7 39
448 #define f8 40
449 #define f9 41
450 #define f10 42
451 #define f11 43
452 #define f12 44
453 #define f13 45
454 #define f14 46
455 #define f15 47
456 #define f16 48
457 #define f17 49
458 #define f18 50
459 #define f19 51
460 #define f20 52
461 #define f21 53
462 #define f22 54
463 #define f23 55
464 #define f24 56
465 #define f25 57
466 #define f26 58
467 #define f27 59
468 #define f28 60
469 #define f29 61
470 #define f30 62
471 #define f31 63
472 #endif
473 #if i386_TARGET_ARCH
474 #define eax 0
475 #define ebx 1
476 #define ecx 2
477 #define edx 3
478 #define esi 4
479 #define edi 5
480 #define ebp 6
481 #define esp 7
482 #define fake0 8
483 #define fake1 9
484 #define fake2 10
485 #define fake3 11
486 #define fake4 12
487 #define fake5 13
488 #endif
489 #if sparc_TARGET_ARCH
490 #define g0 0
491 #define g1 1
492 #define g2 2
493 #define g3 3
494 #define g4 4
495 #define g5 5
496 #define g6 6
497 #define g7 7
498 #define o0 8
499 #define o1 9
500 #define o2 10
501 #define o3 11
502 #define o4 12
503 #define o5 13
504 #define o6 14
505 #define o7 15
506 #define l0 16
507 #define l1 17
508 #define l2 18
509 #define l3 19
510 #define l4 20
511 #define l5 21
512 #define l6 22
513 #define l7 23
514 #define i0 24
515 #define i1 25
516 #define i2 26
517 #define i3 27
518 #define i4 28
519 #define i5 29
520 #define i6 30
521 #define i7 31
522 #define f0 32
523 #define f1 33
524 #define f2 34
525 #define f3 35
526 #define f4 36
527 #define f5 37
528 #define f6 38
529 #define f7 39
530 #define f8 40
531 #define f9 41
532 #define f10 42
533 #define f11 43
534 #define f12 44
535 #define f13 45
536 #define f14 46
537 #define f15 47
538 #define f16 48
539 #define f17 49
540 #define f18 50
541 #define f19 51
542 #define f20 52
543 #define f21 53
544 #define f22 54
545 #define f23 55
546 #define f24 56
547 #define f25 57
548 #define f26 58
549 #define f27 59
550 #define f28 60
551 #define f29 61
552 #define f30 62
553 #define f31 63
554 #endif
555 \end{code}
556
557 \begin{code}
558 baseRegOffset :: MagicId -> Int
559
560 baseRegOffset (VanillaReg _ ILIT(1)) = OFFSET_R1
561 baseRegOffset (VanillaReg _ ILIT(2)) = OFFSET_R2
562 baseRegOffset (VanillaReg _ ILIT(3)) = OFFSET_R3
563 baseRegOffset (VanillaReg _ ILIT(4)) = OFFSET_R4
564 baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
565 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
566 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
567 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
568 baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9
569 baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10
570 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_F1
571 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_F2
572 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_F3
573 baseRegOffset (FloatReg  ILIT(4))    = OFFSET_F4
574 baseRegOffset (DoubleReg ILIT(1))    = OFFSET_D1
575 baseRegOffset (DoubleReg ILIT(2))    = OFFSET_D2
576 baseRegOffset Sp                     = OFFSET_Sp
577 baseRegOffset Su                     = OFFSET_Su
578 baseRegOffset SpLim                  = OFFSET_SpLim
579 #ifdef OFFSET_Lng1
580 baseRegOffset (LongReg _ ILIT(1))    = OFFSET_Lng1
581 #endif
582 #ifdef OFFSET_Lng2
583 baseRegOffset (LongReg _ ILIT(2))    = OFFSET_Lng2
584 #endif
585 baseRegOffset Hp                     = OFFSET_Hp
586 baseRegOffset HpLim                  = OFFSET_HpLim
587 #ifdef DEBUG
588 baseRegOffset BaseReg                = panic "baseRegOffset:BaseReg"
589 baseRegOffset CurCostCentre          = panic "baseRegOffset:CurCostCentre"
590 baseRegOffset VoidReg                = panic "baseRegOffset:VoidReg"
591 #endif
592 \end{code}
593
594 \begin{code}
595 callerSaves :: MagicId -> Bool
596
597 #ifdef CALLER_SAVES_Base
598 callerSaves BaseReg                     = True
599 #endif
600 #ifdef CALLER_SAVES_R1
601 callerSaves (VanillaReg _ ILIT(1))      = True
602 #endif
603 #ifdef CALLER_SAVES_R2
604 callerSaves (VanillaReg _ ILIT(2))      = True
605 #endif
606 #ifdef CALLER_SAVES_R3
607 callerSaves (VanillaReg _ ILIT(3))      = True
608 #endif
609 #ifdef CALLER_SAVES_R4
610 callerSaves (VanillaReg _ ILIT(4))      = True
611 #endif
612 #ifdef CALLER_SAVES_R5
613 callerSaves (VanillaReg _ ILIT(5))      = True
614 #endif
615 #ifdef CALLER_SAVES_R6
616 callerSaves (VanillaReg _ ILIT(6))      = True
617 #endif
618 #ifdef CALLER_SAVES_R7
619 callerSaves (VanillaReg _ ILIT(7))      = True
620 #endif
621 #ifdef CALLER_SAVES_R8
622 callerSaves (VanillaReg _ ILIT(8))      = True
623 #endif
624 #ifdef CALLER_SAVES_F1
625 callerSaves (FloatReg ILIT(1))          = True
626 #endif
627 #ifdef CALLER_SAVES_F2
628 callerSaves (FloatReg ILIT(2))          = True
629 #endif
630 #ifdef CALLER_SAVES_F3
631 callerSaves (FloatReg ILIT(3))          = True
632 #endif
633 #ifdef CALLER_SAVES_F4
634 callerSaves (FloatReg ILIT(4))          = True
635 #endif
636 #ifdef CALLER_SAVES_D1
637 callerSaves (DoubleReg ILIT(1))         = True
638 #endif
639 #ifdef CALLER_SAVES_D2
640 callerSaves (DoubleReg ILIT(2))         = True
641 #endif
642 #ifdef CALLER_SAVES_L1
643 callerSaves (LongReg _ ILIT(1))         = True
644 #endif
645 #ifdef CALLER_SAVES_Sp
646 callerSaves Sp                          = True
647 #endif
648 #ifdef CALLER_SAVES_Su
649 callerSaves Su                          = True
650 #endif
651 #ifdef CALLER_SAVES_SpLim
652 callerSaves SpLim                       = True
653 #endif
654 #ifdef CALLER_SAVES_Hp
655 callerSaves Hp                          = True
656 #endif
657 #ifdef CALLER_SAVES_HpLim
658 callerSaves HpLim                       = True
659 #endif
660 callerSaves _                           = False
661 \end{code}
662
663 \begin{code}
664 magicIdRegMaybe :: MagicId -> Maybe Reg
665
666 #ifdef REG_Base
667 magicIdRegMaybe BaseReg                 = Just (FixedReg ILIT(REG_Base))
668 #endif
669 #ifdef REG_R1
670 magicIdRegMaybe (VanillaReg _ ILIT(1))  = Just (FixedReg ILIT(REG_R1))
671 #endif 
672 #ifdef REG_R2 
673 magicIdRegMaybe (VanillaReg _ ILIT(2))  = Just (FixedReg ILIT(REG_R2))
674 #endif 
675 #ifdef REG_R3 
676 magicIdRegMaybe (VanillaReg _ ILIT(3))  = Just (FixedReg ILIT(REG_R3))
677 #endif 
678 #ifdef REG_R4 
679 magicIdRegMaybe (VanillaReg _ ILIT(4))  = Just (FixedReg ILIT(REG_R4))
680 #endif 
681 #ifdef REG_R5 
682 magicIdRegMaybe (VanillaReg _ ILIT(5))  = Just (FixedReg ILIT(REG_R5))
683 #endif 
684 #ifdef REG_R6 
685 magicIdRegMaybe (VanillaReg _ ILIT(6))  = Just (FixedReg ILIT(REG_R6))
686 #endif 
687 #ifdef REG_R7 
688 magicIdRegMaybe (VanillaReg _ ILIT(7))  = Just (FixedReg ILIT(REG_R7))
689 #endif 
690 #ifdef REG_R8 
691 magicIdRegMaybe (VanillaReg _ ILIT(8))  = Just (FixedReg ILIT(REG_R8))
692 #endif
693 #ifdef REG_R9 
694 magicIdRegMaybe (VanillaReg _ ILIT(9))  = Just (FixedReg ILIT(REG_R9))
695 #endif
696 #ifdef REG_R10 
697 magicIdRegMaybe (VanillaReg _ ILIT(10)) = Just (FixedReg ILIT(REG_R10))
698 #endif
699 #ifdef REG_F1
700 magicIdRegMaybe (FloatReg ILIT(1))      = Just (FixedReg ILIT(REG_F1))
701 #endif                                  
702 #ifdef REG_F2                           
703 magicIdRegMaybe (FloatReg ILIT(2))      = Just (FixedReg ILIT(REG_F2))
704 #endif                                  
705 #ifdef REG_F3                           
706 magicIdRegMaybe (FloatReg ILIT(3))      = Just (FixedReg ILIT(REG_F3))
707 #endif                                  
708 #ifdef REG_F4                           
709 magicIdRegMaybe (FloatReg ILIT(4))      = Just (FixedReg ILIT(REG_F4))
710 #endif                                  
711 #ifdef REG_D1                           
712 magicIdRegMaybe (DoubleReg ILIT(1))     = Just (FixedReg ILIT(REG_D1))
713 #endif                                  
714 #ifdef REG_D2                           
715 magicIdRegMaybe (DoubleReg ILIT(2))     = Just (FixedReg ILIT(REG_D2))
716 #endif
717 #ifdef REG_Sp       
718 magicIdRegMaybe Sp                      = Just (FixedReg ILIT(REG_Sp))
719 #endif
720 #ifdef REG_Lng1                         
721 magicIdRegMaybe (LongReg _ ILIT(1))     = Just (FixedReg ILIT(REG_Lng1))
722 #endif                                  
723 #ifdef REG_Lng2                         
724 magicIdRegMaybe (LongReg _ ILIT(2))     = Just (FixedReg ILIT(REG_Lng2))
725 #endif
726 #ifdef REG_Su                           
727 magicIdRegMaybe Su                      = Just (FixedReg ILIT(REG_Su))
728 #endif                                  
729 #ifdef REG_SpLim                                
730 magicIdRegMaybe SpLim                   = Just (FixedReg ILIT(REG_SpLim))
731 #endif                                  
732 #ifdef REG_Hp                           
733 magicIdRegMaybe Hp                      = Just (FixedReg ILIT(REG_Hp))
734 #endif                                  
735 #ifdef REG_HpLim                        
736 magicIdRegMaybe HpLim                   = Just (FixedReg ILIT(REG_HpLim))
737 #endif                                  
738 magicIdRegMaybe _                       = Nothing
739 \end{code}
740
741 \begin{code}
742 -------------------------------
743 freeRegs :: [Reg]
744 freeRegs
745   = freeMappedRegs IF_ARCH_alpha( [0..63],
746                    IF_ARCH_i386(  [0..13],
747                    IF_ARCH_sparc( [0..63],)))
748
749 -------------------------------
750 callClobberedRegs :: [Reg]
751 callClobberedRegs
752   = freeMappedRegs
753 #if alpha_TARGET_ARCH
754     [0, 1, 2, 3, 4, 5, 6, 7, 8,
755      16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
756      fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
757      fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
758      fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
759 #endif {- alpha_TARGET_ARCH -}
760 #if i386_TARGET_ARCH
761     [{-none-}]
762 #endif {- i386_TARGET_ARCH -}
763 #if sparc_TARGET_ARCH
764     ( oReg 7 :
765       [oReg i | i <- [0..5]] ++
766       [gReg i | i <- [1..7]] ++
767       [fReg i | i <- [0..31]] )
768 #endif {- sparc_TARGET_ARCH -}
769
770 -------------------------------
771 argRegs :: Int -> [Reg]
772
773 argRegs 0 = []
774 #if i386_TARGET_ARCH
775 argRegs _ = panic "MachRegs.argRegs: doesn't work on I386"
776 #else
777 #if alpha_TARGET_ARCH
778 argRegs 1 = freeMappedRegs [16, fReg 16]
779 argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
780 argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
781 argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
782 argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
783 argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
784 #endif {- alpha_TARGET_ARCH -}
785 #if sparc_TARGET_ARCH
786 argRegs 1 = freeMappedRegs (map oReg [0])
787 argRegs 2 = freeMappedRegs (map oReg [0,1])
788 argRegs 3 = freeMappedRegs (map oReg [0,1,2])
789 argRegs 4 = freeMappedRegs (map oReg [0,1,2,3])
790 argRegs 5 = freeMappedRegs (map oReg [0,1,2,3,4])
791 argRegs 6 = freeMappedRegs (map oReg [0,1,2,3,4,5])
792 #endif {- sparc_TARGET_ARCH -}
793 argRegs _ = panic "MachRegs.argRegs: don't know about >6 arguments!"
794 #endif {- i386_TARGET_ARCH -}
795
796 -------------------------------
797
798 #if alpha_TARGET_ARCH
799 allArgRegs :: [(Reg, Reg)]
800
801 allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
802 #endif {- alpha_TARGET_ARCH -}
803
804 #if sparc_TARGET_ARCH
805 allArgRegs :: [Reg]
806
807 allArgRegs = map realReg [oReg i | i <- [0..5]]
808 #endif {- sparc_TARGET_ARCH -}
809
810 -------------------------------
811 freeMappedRegs :: [Int] -> [Reg]
812
813 freeMappedRegs nums
814   = foldr free [] nums
815   where
816     free IBOX(i) acc
817       = if _IS_TRUE_(freeReg i) then (MappedReg i) : acc else acc
818 \end{code}
819
820 \begin{code}
821 freeReg :: FAST_INT -> FAST_BOOL
822
823 #if alpha_TARGET_ARCH
824 freeReg ILIT(26) = _FALSE_  -- return address (ra)
825 freeReg ILIT(28) = _FALSE_  -- reserved for the assembler (at)
826 freeReg ILIT(29) = _FALSE_  -- global pointer (gp)
827 freeReg ILIT(30) = _FALSE_  -- stack pointer (sp)
828 freeReg ILIT(31) = _FALSE_  -- always zero (zeroh)
829 freeReg ILIT(63) = _FALSE_  -- always zero (f31)
830 #endif
831
832 #if i386_TARGET_ARCH
833 freeReg ILIT(esp) = _FALSE_  -- %esp is the C stack pointer
834 #endif
835
836 #if sparc_TARGET_ARCH
837 freeReg ILIT(g0) = _FALSE_  --  %g0 is always 0.
838 freeReg ILIT(g5) = _FALSE_  --  %g5 is reserved (ABI).
839 freeReg ILIT(g6) = _FALSE_  --  %g6 is reserved (ABI).
840 freeReg ILIT(g7) = _FALSE_  --  %g7 is reserved (ABI).
841 freeReg ILIT(i6) = _FALSE_  --  %i6 is our frame pointer.
842 freeReg ILIT(o6) = _FALSE_  --  %o6 is our stack pointer.
843 #endif
844
845 #ifdef REG_Base
846 freeReg ILIT(REG_Base) = _FALSE_
847 #endif
848 #ifdef REG_R1
849 freeReg ILIT(REG_R1)   = _FALSE_
850 #endif  
851 #ifdef REG_R2  
852 freeReg ILIT(REG_R2)   = _FALSE_
853 #endif  
854 #ifdef REG_R3  
855 freeReg ILIT(REG_R3)   = _FALSE_
856 #endif  
857 #ifdef REG_R4  
858 freeReg ILIT(REG_R4)   = _FALSE_
859 #endif  
860 #ifdef REG_R5  
861 freeReg ILIT(REG_R5)   = _FALSE_
862 #endif  
863 #ifdef REG_R6  
864 freeReg ILIT(REG_R6)   = _FALSE_
865 #endif  
866 #ifdef REG_R7  
867 freeReg ILIT(REG_R7)   = _FALSE_
868 #endif  
869 #ifdef REG_R8  
870 freeReg ILIT(REG_R8)   = _FALSE_
871 #endif
872 #ifdef REG_F1
873 freeReg ILIT(REG_F1) = _FALSE_
874 #endif
875 #ifdef REG_F2
876 freeReg ILIT(REG_F2) = _FALSE_
877 #endif
878 #ifdef REG_F3
879 freeReg ILIT(REG_F3) = _FALSE_
880 #endif
881 #ifdef REG_F4
882 freeReg ILIT(REG_F4) = _FALSE_
883 #endif
884 #ifdef REG_D1
885 freeReg ILIT(REG_D1) = _FALSE_
886 #endif
887 #ifdef REG_D2
888 freeReg ILIT(REG_D2) = _FALSE_
889 #endif
890 #ifdef REG_Sp 
891 freeReg ILIT(REG_Sp)   = _FALSE_
892 #endif 
893 #ifdef REG_Su
894 freeReg ILIT(REG_Su)   = _FALSE_
895 #endif 
896 #ifdef REG_SpLim 
897 freeReg ILIT(REG_SpLim) = _FALSE_
898 #endif 
899 #ifdef REG_Hp 
900 freeReg ILIT(REG_Hp)   = _FALSE_
901 #endif
902 #ifdef REG_HpLim
903 freeReg ILIT(REG_HpLim) = _FALSE_
904 #endif
905 freeReg n
906   -- we hang onto two double regs for dedicated
907   -- use; this is not necessary on Alphas and
908   -- may not be on other non-SPARCs.
909 #ifdef REG_D1
910   | n _EQ_ (ILIT(REG_D1) _ADD_ ILIT(1)) = _FALSE_
911 #endif
912 #ifdef REG_D2
913   | n _EQ_ (ILIT(REG_D2) _ADD_ ILIT(1)) = _FALSE_
914 #endif
915   | otherwise = _TRUE_
916 \end{code}