Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/amd64/staged-allocation/amd64-svid.sml
ViewVC logotype

Annotation of /MLRISC/trunk/amd64/staged-allocation/amd64-svid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2926 - (view) (download)

1 : mrainey 2619 (* amd64-svid-fn.sml
2 :     *
3 :     * C calling conventions using staged allocation.
4 :     *)
5 :    
6 :     functor AMD64SVID (
7 :     structure T : MLTREE
8 :     (* alignment requirement for stack frames; should be a power of two
9 :     * that is at least eight.
10 :     *)
11 :     val frameAlign : int
12 :     ) : C_CALL =
13 :     struct
14 :    
15 :     structure T = T
16 :     structure C = AMD64Cells
17 :     structure CB = CellsBasis
18 :     structure CTy = CTypes
19 :    
20 :     val wordTy = 64
21 :     val stack = T.Region.stack
22 :     val mem = T.Region.memory
23 :     fun gpr r = T.GPR (T.REG (wordTy, r))
24 :     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
25 :    
26 :     (* GPRs *)
27 :     val [rax, rbx, rdi, rsi, rdx, rcx, r8, r9, r10, r11, r12, r13, r14, r15] =
28 :     map (fn r => (wordTy, r))
29 :     ([C.rax, C.rbx, C.rdi, C.rsi, C.rdx, C.rcx] @
30 :     C.Regs CB.GP {from=8, to=15, step=1})
31 :     (* FPRs *)
32 :     val sseFRegs as
33 :     [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, xmm8, xmm9, xmm10,
34 :     xmm11, xmm12, xmm13, xmm14, xmm15] =
35 :     map (fn r => (64, r)) (C.Regs CB.FP {from=0, to=15, step=1})
36 :     val calleeSaveRegs = map #2 [rbx, r12, r13, r14, r15]
37 :     val callerSaveRegs = map #2 [rax, rcx, rdx, rsi, rdi, r8, r9, r10, r11]
38 :     val callerSaveFRegs = sseFRegs
39 :     val calleeSaveFRegs = []
40 :    
41 :     datatype c_arg
42 :     = ARG of T.rexp
43 :     (* rexp specifies integer or pointer; if the
44 :     * corresponding parameter is a C struct, then
45 :     * this argument is the address of the struct.
46 :     *)
47 :     | FARG of T.fexp
48 :     (* fexp specifies floating-point argument *)
49 :     | ARGS of c_arg list
50 :     (* list of arguments corresponding to the contents of a C struct *)
51 :     datatype location_kind = K_GPR | K_FPR | K_MEM
52 :     structure TargetLang =
53 :     struct
54 :     datatype location_kind = datatype location_kind
55 :     end
56 :     structure StagedAllocation = StagedAllocationFn (
57 :     structure T = T
58 :     structure TargetLang = TargetLang )
59 :     structure S = StagedAllocation
60 :    
61 :     (* This structure contains the automaton used in staged allocation. *)
62 :     structure SVIDConventions =
63 :     struct
64 :    
65 :     type reg = (int * CellsBasis.cell)
66 :     type slot = S.slot
67 :     type location_info = S.location_info
68 :     type automaton = {s0 : S.str, step : S.stepper_fn}
69 :    
70 :     val gprParams = [rdi, rsi, rdx, rcx, r8, r9]
71 :     val fprParams = [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7]
72 :    
73 :     val maxAlign = 16
74 :    
75 :     (* parameter-passing conventions *)
76 :     fun call () = let
77 :     val cStack = S.freshCounter ()
78 :     val cInt = S.freshCounter ()
79 :     val cFloat = S.freshCounter ()
80 :     in
81 :     ( cStack, [cStack, cInt, cFloat],
82 :     [ S.CHOICE [
83 :     (* GPR *)
84 :     (fn (w, k, str) => k = K_GPR, S.SEQ [
85 :     S.WIDEN (fn w => Int.max (wordTy, w)),
86 :     S.BITCOUNTER cInt,
87 :     S.REGS_BY_BITS (cInt, gprParams)] ),
88 :     (* FPR *)
89 :     (fn (w, k, str) => k = K_FPR, S.SEQ [
90 :     S.WIDEN (fn w => Int.max (64, w)),
91 :     S.BITCOUNTER cFloat,
92 :     S.REGS_BY_BITS (cFloat, fprParams) ]),
93 :     (* MEM *)
94 :     (fn (w, k, str) => k = K_MEM,
95 :     S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}) ],
96 :     S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}
97 :     ] )
98 :     end (* call *)
99 :    
100 :     val gprRets = [rax, rdx]
101 :     val fprRets = [xmm0, xmm1]
102 :    
103 :     (* value-returning conventions *)
104 :     fun return () = let
105 :     val (cFloat, ssFloat) = S.useRegs fprRets
106 :     val (cInt, ssGpr) = S.useRegs gprRets
107 :     in
108 :     ( [cFloat, cInt],
109 :     [ S.CHOICE [
110 :     (* GPR *)
111 :     (fn (w, k, str) => k = K_GPR,
112 :     S.SEQ [S.WIDEN (fn w => Int.max (wordTy, w)), ssGpr]),
113 :     (* FPR *)
114 :     (fn (w, k, str) => k = K_FPR,
115 :     S.SEQ [S.WIDEN (fn w => Int.max (64, w)), ssFloat]),
116 :     (* MEM *)
117 :     (fn (w, k, str) => k = K_MEM,
118 :     (* FIXME! *)
119 :     ssGpr) ]
120 :     ] )
121 :     end (* return *)
122 :    
123 :     (* For calls and returns, genAutomaton, initializes counters,
124 :     * returns an initial store, and returns a stepper function.
125 :     * Calls also have a finisher function that returns the size
126 :     * of the argument area.
127 :     *)
128 :     fun genAutomaton () = let
129 :     val (stackCounter, callCounters, callStates) = call ()
130 :     val (retCounters, retStates) = return ()
131 :     fun finish str = S.find (str, stackCounter)
132 :     in
133 :     {call = {cS0=S.init callCounters,
134 :     cStep=S.mkStep callStates, finish=finish},
135 :     ret = {rS0=S.init retCounters, rStep=S.mkStep retStates}}
136 :     end (* genAutomaton *)
137 :    
138 :     end (* SVIDConventions *)
139 :    
140 :     (* An arg_location specifies the location of arguments/parameters
141 :     * for a C call. Offsets are given with respect to the low end
142 :     * of the parameter area. *)
143 :     datatype arg_location =
144 :     C_GPR of (T.ty * T.reg) (* integer/pointer argument in register *)
145 :     | C_FPR of (T.fty * T.reg) (* floating-point argument in register *)
146 :     | C_STK of (T.ty * T.I.machine_int) (* integer/pointer argument on the call stack *)
147 :     | C_FSTK of (T.fty * T.I.machine_int) (* floating-point argument on the call stack *)
148 :    
149 :     fun kindOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = K_FPR
150 :     | kindOfCTy (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _) = K_MEM
151 :     | kindOfCTy _ = K_GPR
152 :     fun szToLoc cty {sz, align} = (sz * 8, kindOfCTy cty, align)
153 :     fun cTyToLoc cty = szToLoc cty (CSizes.sizeOfTy cty)
154 :    
155 :     fun argLoc _ (w, S.REG (_, r), K_GPR) = C_GPR (w, r)
156 :     | argLoc _ (w, S.REG (_, r), K_FPR) = C_FPR (w, r)
157 :     | argLoc argOffset (w, S.BLOCK_OFFSET offB, K_GPR) =
158 :     C_STK (w, T.I.fromInt (wordTy, offB+argOffset))
159 :     | argLoc argOffset (w, S.NARROW (loc, w', k), _) =
160 :     argLoc argOffset (w', loc, k)
161 :     | argLoc _ (w, S.COMBINE _, _) = raise Fail "impossible"
162 :    
163 : mrainey 2926 (* takes a calling convention, return type, and param types and returns locations for setting up the call *)
164 : mrainey 2619 fun layout {conv, retTy, paramTys} = let
165 : mrainey 2926 val {call={cS0, cStep, finish}, ret={rS0, rStep}} = SVIDConventions.genAutomaton ()
166 :     (* generate locations for the return *)
167 : mrainey 2619 fun rLoc () = argLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))
168 :     val (resLoc, structRetLoc, argOffset) = (case retTy
169 :     of CTy.C_void => (NONE, NONE, 0)
170 :     | CTy.C_UNION tys => raise Fail "todo"
171 :     | CTy.C_STRUCT tys => let
172 :     val {sz, align} = CSizes.sizeOfStruct tys
173 :     in
174 :     (SOME (rLoc ()), SOME {szb=sz, align=align}, 8)
175 :     end
176 :     | _ => (SOME (rLoc ()), NONE, 0)
177 : mrainey 2888 (* end case *))
178 : mrainey 2619 val argLoc = argLoc argOffset
179 : mrainey 2926 (* generate locations for the call *)
180 : mrainey 2619 fun assign (str, [], locs) = (finish str, rev locs)
181 :     | assign (str, pTy :: pTys, locs) = let
182 :     val (str', cLoc) = cStep (str, cTyToLoc pTy)
183 :     val loc = argLoc cLoc
184 :     in
185 :     assign (str', pTys, loc:: locs)
186 :     end (* assign *)
187 :     val (frameSz, argLocs) = assign (cS0, paramTys, [])
188 : mrainey 2926 val argMem = {szb=CSizes.alignAddr (frameSz, frameAlign), align=frameAlign}
189 : mrainey 2619 in
190 : mrainey 2926 {argLocs=argLocs, resLoc=resLoc, argMem=argMem, structRetLoc=structRetLoc}
191 : mrainey 2619 end (* layout *)
192 :    
193 :     val spReg = T.REG (wordTy, C.rsp)
194 :    
195 : mrainey 2888 fun genCall {name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args} = let
196 : mrainey 2619 val {argLocs, argMem, resLoc, structRetLoc} = layout proto
197 :     val argAlloc = if ((#szb argMem = 0) orelse paramAlloc argMem)
198 :     then []
199 :     else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,
200 :     T.LI (T.I.fromInt (wordTy, #szb argMem))))]
201 : mrainey 2926 val (copyArgs, gprUses, fprUses) = let
202 : mrainey 2619 fun offSp 0 = spReg
203 :     | offSp offset = T.ADD (wordTy, spReg, T.LI offset)
204 : mrainey 2926 fun f ([], [], stms, gprs, fprs) = (rev stms, gprs, fprs)
205 :     | f (arg :: args, loc :: locs, stms, gprs, fprs) = let
206 :     val (stms, gprs, fprs) = (case (arg, loc)
207 : mrainey 2619 of (ARG (e as T.REG _), C_STK (mty, offset)) =>
208 : mrainey 2926 (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)
209 : mrainey 2619 | (ARG e, C_STK (mty, offset)) => let
210 :     val tmp = C.newReg ()
211 :     in
212 : mrainey 2926 (T.STORE (mty, offSp offset, T.REG (mty, tmp), stack) ::T.MV (mty, tmp, e) :: stms, gprs, fprs)
213 : mrainey 2619 end
214 :     | (ARG e, C_GPR (mty, r)) => let
215 :     val tmp = C.newReg ()
216 :     in
217 : mrainey 2926 (T.COPY (mty, [r], [tmp]) :: T.MV (mty, tmp, e) :: stms, r :: gprs, fprs)
218 : mrainey 2619 end
219 :     | (FARG (e as T.FREG _), C_STK (mty, offset)) =>
220 : mrainey 2926 (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)
221 : mrainey 2619 | (FARG e, C_STK (mty, offset)) => let
222 :     val tmp = C.newFreg ()
223 :     in
224 : mrainey 2926 (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) :: T.FMV (mty, tmp, e) :: stms, gprs, fprs)
225 : mrainey 2619 end
226 :     | (FARG e, C_FPR (mty, r)) => let
227 :     val tmp = C.newFreg ()
228 :     in
229 : mrainey 2926 (T.FCOPY (mty, [r], [tmp]) :: T.FMV (mty, tmp, e) :: stms, gprs, (mty, r) :: fprs)
230 : mrainey 2619 end
231 :     | _ => raise Fail "todo"
232 : mrainey 2888 (* end case *))
233 : mrainey 2619 in
234 : mrainey 2926 f (args, locs, stms, gprs, fprs)
235 : mrainey 2619 end
236 :     | f _ = raise Fail "argument arity error"
237 :     in
238 : mrainey 2926 f (args, argLocs, [], [], [])
239 : mrainey 2619 end
240 : mrainey 2926 (* the defined registers of the call depend on the calling convention *)
241 : mrainey 2888 val defs = (case #conv proto
242 : mrainey 2926 of "ccall" => List.map gpr callerSaveRegs @ List.map fpr callerSaveFRegs
243 : mrainey 2888 | "ccall-bare" => []
244 :     | conv => raise Fail (concat [
245 :     "unknown calling convention \"", String.toString conv, "\""
246 :     ])
247 :     (* end case *))
248 : mrainey 2926 val uses = List.map gpr gprUses @ List.map fpr fprUses
249 :     val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}
250 : mrainey 2619 val (resultRegs, copyResult) = (case resLoc
251 :     of NONE => ([], [])
252 :     | SOME (C_GPR (ty, r)) => let
253 :     val resReg = C.newReg ()
254 :     in
255 :     ([T.GPR (T.REG (ty, resReg))],
256 :     [T.COPY (ty, [resReg], [r])])
257 :     end
258 :     | SOME (C_FPR (ty, r)) => let
259 :     val resReg = C.newFreg ()
260 :     in
261 :     ([T.FPR (T.FREG (ty, resReg))],
262 :     [T.FCOPY (ty, [resReg], [r])])
263 :     end
264 : mrainey 2888 (* end case *))
265 : mrainey 2619 val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult
266 :     in
267 :     {callseq=callSeq, result=resultRegs}
268 :     end (* genCall *)
269 :    
270 : mrainey 2888 end (* AMD64SVID *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0