CmmCallConv.hs 3.65 KB
Newer Older
1
{-# OPTIONS -w #-}
2
3
4
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
5
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
6
7
-- for details

8
9
10
11
module CmmCallConv (
  ParamLocation(..),
  ArgumentFormat,
  assignArguments,
12
  argumentsSize,
13
14
15
16
17
18
19
20
21
22
23
24
) where

#include "HsVersions.h"

import Cmm
import MachOp
import SMRep

import Constants
import StaticFlags (opt_Unregisterised)
import Panic

25
26
27
-- Calculate the 'GlobalReg' or stack locations for function call
-- parameters as used by the Cmm calling convention.

28
29
30
31
data ParamLocation
  = RegisterParam GlobalReg
  | StackParam WordOff

32
type ArgumentFormat a = [(a, ParamLocation)]
33
34

assignArguments :: (a -> MachRep) -> [a] -> ArgumentFormat a
35
assignArguments f reps = assignments
36
    where
37
      (sizes, assignments) = unzip $ assignArguments' reps (negate (sum sizes)) availRegs
38
      assignArguments' [] offset availRegs = []
39
      assignArguments' (r:rs) offset availRegs =
40
          (size,(r,assignment)):assignArguments' rs new_offset remaining
41
          where 
42
            (assignment, new_offset, size, remaining) =
43
                assign_reg (f r) offset availRegs
44

45
46
47
48
49
50
51
52
53
54
argumentsSize :: (a -> MachRep) -> [a] -> WordOff
argumentsSize f reps = maximum (0 : map arg_top args)
    where
      args = assignArguments f reps

      arg_top (a, StackParam offset) = -offset
      arg_top (_, RegisterParam _) = 0

-----------------------------------------------------------------------------
-- Local information about the registers available
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

type AvailRegs = ( [GlobalReg]   -- available vanilla regs.
		 , [GlobalReg]   -- floats
		 , [GlobalReg]   -- doubles
		 , [GlobalReg]   -- longs (int64 and word64)
		 )

-- Vanilla registers can contain pointers, Ints, Chars.
-- Floats and doubles have separate register supplies.
--
-- We take these register supplies from the *real* registers, i.e. those
-- that are guaranteed to map to machine registers.

useVanillaRegs | opt_Unregisterised = 0
	       | otherwise          = mAX_Real_Vanilla_REG
useFloatRegs   | opt_Unregisterised = 0
	       | otherwise          = mAX_Real_Float_REG
useDoubleRegs  | opt_Unregisterised = 0
	       | otherwise          = mAX_Real_Double_REG
useLongRegs    | opt_Unregisterised = 0
	       | otherwise          = mAX_Real_Long_REG

availRegs = (regList VanillaReg useVanillaRegs,
             regList FloatReg useFloatRegs,
             regList DoubleReg useDoubleRegs,
             regList LongReg useLongRegs)
    where
      regList f max = map f [1 .. max]

slot_size :: LocalReg -> Int
85
86
slot_size reg =
    ((machRepByteWidth (localRegRep reg) - 1) `div` wORD_SIZE) + 1
87
88
89
90

slot_size' :: MachRep -> Int
slot_size' reg = ((machRepByteWidth reg - 1) `div` wORD_SIZE) + 1

91
92
93
94
95
assign_reg :: MachRep -> WordOff -> AvailRegs -> (ParamLocation, WordOff, WordOff, AvailRegs)
assign_reg I8  off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, 0, (vs, fs, ds, ls))
assign_reg I16 off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, 0, (vs, fs, ds, ls))
assign_reg I32 off (v:vs, fs, ds, ls) = (RegisterParam $ v, off, 0, (vs, fs, ds, ls))
assign_reg I64 off (vs, fs, ds, l:ls) = (RegisterParam $ l, off, 0, (vs, fs, ds, ls))
96
assign_reg I128 off _                 = panic "I128 is not a supported register type"
97
98
assign_reg F32 off (vs, f:fs, ds, ls) = (RegisterParam $ f, off, 0, (vs, fs, ds, ls))
assign_reg F64 off (vs, fs, d:ds, ls) = (RegisterParam $ d, off, 0, (vs, fs, ds, ls))
99
assign_reg F80 off _                  = panic "F80 is not a supported register type"
100
assign_reg reg off _                  = (StackParam $ off, off + size, size, ([], [], [], [])) where size = slot_size' reg