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-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3038 - (view) (download)

1 : mrainey 3037 (* amd64-svid-fn.sml
2 :     *
3 :     * C calling conventions for the AMD64. We use the technique of Staged Allocation (see
4 :     * MLRISC/staged-allocation).
5 :     *
6 :     * Mike Rainey (mrainey@cs.uchicago.edu)
7 :     *)
8 :    
9 :     functor AMD64SVIDFn (
10 :     structure T : MLTREE
11 :     ) = struct
12 :    
13 :     structure T = T
14 :     structure C = AMD64Cells
15 :     structure CB = CellsBasis
16 :     structure CTy = CTypes
17 :    
18 :     val wordTy = 64
19 :     val mem = T.Region.memory
20 :     val stack = T.Region.stack
21 :    
22 :     fun lit i = T.LI (T.I.fromInt (wordTy, i))
23 :     fun gpr r = T.GPR (T.REG (wordTy, r))
24 :     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
25 :     fun sum ls = List.foldl (op +) 0 ls
26 :     fun szBOfCTy cTy = #sz (CSizes.sizeOfTy cTy)
27 : mrainey 3038 fun alignBOfCTy cTy = #align (CSizes.sizeOfTy cTy)
28 : mrainey 3037
29 :     fun toGpr r = (wordTy, r)
30 :     fun toGprs gprs = List.map toGpr gprs
31 :     fun toFpr r = (64, r)
32 :     fun toFprs fprs = List.map toFpr fprs
33 :    
34 :    
35 :     datatype location_kind
36 :     = K_GPR (* general-purpose registers *)
37 :     | K_FPR (* floating-point registers *)
38 :     | K_MEM (* memory locations *)
39 :    
40 :     structure SA = StagedAllocationFn (
41 :     structure T = T
42 :     structure TargetLang = struct
43 :     datatype location_kind = datatype location_kind
44 :     end
45 :     val memSize = 8 (* bytes *))
46 :    
47 :     structure CCs =
48 :     struct
49 :    
50 :     val calleeSaveRegs = toGprs [C.rbx, C.r12, C.r13, C.r14, C.r15]
51 :     val callerSaveRegs = toGprs [C.rax, C.rcx, C.rdx, C.rsi, C.rdi, C.r8, C.r9, C.r10, C.r11]
52 :     val callerSaveFRegs = toFprs (C.Regs CB.FP {from=0, to=15, step=1})
53 :     val calleeSaveFRegs = []
54 :     val spReg = T.REG (wordTy, C.rsp)
55 :    
56 :     val maxAlign = 16
57 :    
58 :     (* conventions for returning arguments *)
59 :     val gprRets = toGprs [C.rax, C.rdx]
60 :     val fprRets = toFprs [C.xmm0, C.xmm1]
61 : mrainey 3038 val (cRetFpr, ssFloat) = SA.useRegs fprRets
62 :     val (cRetGpr, ssGpr) = SA.useRegs gprRets
63 : mrainey 3037 val cCallStk = SA.freshCounter ()
64 :     val returnStages = [
65 :     SA.CHOICE [
66 :     (* return in general-purpose register *)
67 :     (fn (w, k, str) => k = K_GPR,
68 :     SA.SEQ [SA.WIDEN (fn w => Int.max (wordTy, w)), ssGpr]),
69 :     (* return in floating-point register *)
70 :     (fn (w, k, str) => k = K_FPR,
71 :     SA.SEQ [SA.WIDEN (fn w => Int.max (64, w)), ssFloat]),
72 :     (* return in a memory location *)
73 :     (fn (w, k, str) => k = K_MEM,
74 :     (* FIXME! *)
75 :     SA.OVERFLOW {counter=cCallStk, blockDirection=SA.UP, maxAlign=maxAlign}) ]
76 :     ]
77 :    
78 :     (* conventions for passing arguments *)
79 :     val gprParams = toGprs [C.rdi, C.rsi, C.rdx, C.rcx, C.r8, C.r9]
80 :     val fprParams = toFprs [C.xmm0, C.xmm1, C.xmm2, C.xmm3, C.xmm4, C.xmm5, C.xmm6, C.xmm7]
81 :     val cCallGpr = SA.freshCounter ()
82 :     val cCallFpr = SA.freshCounter ()
83 :     (* initial store *)
84 : mrainey 3038 val str0 = SA.init [cCallStk, cCallGpr, cCallFpr, cRetFpr, cRetGpr]
85 : mrainey 3037
86 :     val callStages = [
87 :     SA.CHOICE [
88 :     (* pass in general-purpose register *)
89 :     (fn (w, k, str) => k = K_GPR, SA.SEQ [
90 :     SA.WIDEN (fn w => Int.max (wordTy, w)),
91 :     SA.BITCOUNTER cCallGpr,
92 :     SA.REGS_BY_BITS (cCallGpr, gprParams) ]),
93 :     (* pass in floating point register *)
94 :     (fn (w, k, str) => k = K_FPR, SA.SEQ [
95 :     SA.WIDEN (fn w => Int.max (64, w)),
96 :     SA.BITCOUNTER cCallFpr,
97 :     SA.REGS_BY_BITS (cCallFpr, fprParams) ]),
98 :     (* pass on the stack *)
99 :     (fn (w, k, str) => k = K_MEM,
100 :     SA.OVERFLOW {counter=cCallStk, blockDirection=SA.UP, maxAlign=maxAlign})
101 :     ],
102 :     SA.OVERFLOW {counter=cCallStk, blockDirection=SA.UP, maxAlign=maxAlign}
103 :     ]
104 :    
105 :     end (* CCs *)
106 :    
107 :     structure CCall = CCallFn (
108 :     structure T = T
109 :     structure C = C
110 :     val wordTy = wordTy
111 :     fun offSp 0 = CCs.spReg
112 :     | offSp offset = T.ADD (wordTy, CCs.spReg, T.LI offset))
113 :    
114 :     datatype c_arg = datatype CCall.c_arg
115 :    
116 :     (* convert a list of C types to a list of eight bytes *)
117 : mrainey 3038 fun eightBytesOfCTys ([], [], ebs) = List.rev (List.map List.rev ebs)
118 :     | eightBytesOfCTys ([], eb, ebs) = List.rev (List.map List.rev (eb :: ebs))
119 : mrainey 3037 | eightBytesOfCTys (cTy :: cTys, eb, ebs) = let
120 :     val szTy = szBOfCTy cTy
121 :     val szEb = sum(List.map szBOfCTy eb)
122 :     in
123 :     if szTy + szEb = 8
124 :     then eightBytesOfCTys(cTys, [], (cTy :: eb) :: ebs)
125 :     else if szTy + szEb < 8
126 :     then eightBytesOfCTys(cTys, cTy :: eb, ebs)
127 :     else eightBytesOfCTys(cTys, [cTy], eb :: ebs)
128 :     end
129 :    
130 :     (* convert a C type into its eight bytes *)
131 :     fun eightBytesOfCTy cTy = eightBytesOfCTys (CTypes.flattenCTy cTy, [], [])
132 :    
133 :     (* classify a C type into its location kind (assuming that aggregates cannot be passed in registers) *)
134 :     fun kindOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = K_FPR
135 : mrainey 3038 | kindOfCTy (CTy.C_ARRAY _ | CTy.C_STRUCT _ | CTy.C_UNION _) = raise Fail "impossible"
136 : mrainey 3037 | kindOfCTy (CTy.C_unsigned _ | CTy.C_signed _ | CTy.C_PTR) = K_GPR
137 :    
138 :     fun combineKinds (k1, k2) = if (k1 = k2)
139 :     then k1
140 :     else (case (k1, k2)
141 :     of (K_MEM, _) => K_MEM
142 :     | (_, K_MEM) => K_MEM
143 :     | (K_GPR, _) => K_GPR
144 :     | (_, K_GPR) => K_GPR
145 :     | _ => K_FPR
146 :     (* end case*))
147 :    
148 :     (* this part of the ABI is tricky. if the eightbyte contains all floats, we use fprs, but
149 :     * otherwise we use gprs. *)
150 :     fun kindOfEightByte [] = raise Fail "impossible"
151 :     | kindOfEightByte [cTy] = kindOfCTy cTy
152 :     | kindOfEightByte (cTy1 :: cTy2 :: cTys) = let
153 :     val k1 = combineKinds (kindOfCTy cTy1, kindOfCTy cTy2)
154 :     val k2 = kindOfEightByte(cTy2 :: cTys)
155 :     in
156 :     combineKinds(k1, k2)
157 :     end
158 :    
159 :     fun containsUnalignedFields cTy = (case cTy
160 : mrainey 3038 of (CTy.C_STRUCT cTys | CTy.C_UNION cTys) => List.exists containsUnalignedFields cTys
161 :     | cTy => Int.max(8, szBOfCTy cTy) mod 8 <> 0
162 :     (* end case *))
163 : mrainey 3037
164 : mrainey 3038 fun slotsOfCTy (cTy as (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _)) =
165 : mrainey 3037 if (szBOfCTy cTy > 2*8 orelse containsUnalignedFields cTy)
166 : mrainey 3038 then List.tabulate (szBOfCTy cTy div 8, fn _ => (8*8, K_MEM, 8))
167 :     else List.map (fn eb => (8*8, kindOfEightByte eb, 8)) (eightBytesOfCTy cTy)
168 :     | slotsOfCTy cTy = [(8*szBOfCTy cTy, kindOfCTy cTy, alignBOfCTy cTy)]
169 : mrainey 3037
170 :     fun slotOfCTy cTy = (case slotsOfCTy cTy
171 :     of [slot] => slot
172 :     | _ => raise Fail "malformed C type"
173 :     (* end case *))
174 :    
175 :     (* C location of a staged allocation location *)
176 :     fun cLocOfStagedAlloc (w, SA.REG (_, r), K_GPR) = CCall.C_GPR (w, r)
177 :     | cLocOfStagedAlloc (w, SA.REG (_, r), K_FPR) = CCall.C_FPR (w, r)
178 :     | cLocOfStagedAlloc (w, SA.BLOCK_OFFSET offB, (K_GPR | K_FPR | K_MEM)) =
179 : mrainey 3038 CCall.C_STK (w, T.I.fromInt (wordTy, offB))
180 : mrainey 3037 | cLocOfStagedAlloc (w, SA.NARROW (loc, w', k), _) = cLocOfStagedAlloc (w', loc, k)
181 :     | cLocOfStagedAlloc _ = raise Fail "impossible"
182 :    
183 :     (* given a return type, return the locations for the return values *)
184 :     fun layoutReturn retTy = let
185 :     val returnStepper = SA.mkStep CCs.returnStages
186 :     in
187 :     case retTy
188 :     of CTy.C_void => ([], NONE, CCs.str0)
189 :     | retTy => let
190 :     val (str, locs) = SA.doStagedAllocation(CCs.str0, returnStepper, slotsOfCTy retTy)
191 :     in
192 :     (List.map cLocOfStagedAlloc locs, SOME (CSizes.sizeOfTy retTy), str)
193 :     end
194 :     end
195 :    
196 :     (* given a store and some parameters, return the C locations for those parameters *)
197 :     fun layoutCall (str, paramTys) = let
198 :     val callStepper = SA.mkStep CCs.callStages
199 :     fun doParam (paramTy, (str, paramLocss)) = let
200 :     val (str', paramLocs) = SA.doStagedAllocation(str, callStepper, slotsOfCTy paramTy)
201 :     in
202 :     (str', List.map cLocOfStagedAlloc paramLocs :: paramLocss)
203 :     end
204 :     val (str, paramLocss) = List.foldl doParam (str, []) paramTys
205 :     in
206 :     (List.rev paramLocss, str)
207 :     end
208 :    
209 :     fun layout {conv, retTy, paramTys} = let
210 :     val (resLocs, structRetLoc, str) = layoutReturn retTy
211 :     val (paramLocss, str) = layoutCall(str, paramTys)
212 :     (* number of bytes allocated for the call *)
213 :     val cStkSzB = SA.find(str, CCs.cCallStk)
214 :     in
215 :     {argLocs=paramLocss, argMem={szB=cStkSzB, align=8}, structRetLoc=structRetLoc, resLocs=resLocs}
216 :     end
217 :    
218 :     (* copy the return value into the result location *)
219 :     fun returnVals resLocs = (case resLocs
220 :     of [] => ([], [])
221 :     | [CCall.C_GPR (ty, r)] => let
222 :     val resReg = C.newReg ()
223 :     in
224 :     ([T.GPR (T.REG (ty, resReg))],
225 :     [T.COPY (ty, [resReg], [r])])
226 :     end
227 :     | [CCall.C_FPR (ty, r)] => let
228 :     val resReg = C.newFreg ()
229 :     in
230 :     ([T.FPR (T.FREG (ty, resReg))],
231 :     [T.FCOPY (ty, [resReg], [r])])
232 :     end
233 :     (* end case *))
234 :    
235 :     fun genCall {name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args} = let
236 :     val {argLocs, argMem, resLocs, structRetLoc} = layout(proto)
237 :     val argAlloc = if ((#szB argMem = 0) orelse paramAlloc argMem)
238 :     then []
239 :     else [T.MV (wordTy, C.rsp, T.SUB (wordTy, CCs.spReg,
240 :     T.LI (T.I.fromInt (wordTy, #szB argMem))))]
241 :     val (copyArgs, gprUses, fprUses) = CCall.copyArgs(args, argLocs)
242 :     (* the defined registers of the call depend on the calling convention *)
243 :     val defs = (case #conv proto
244 :     of "ccall" => List.map (gpr o #2) CCs.callerSaveRegs @ List.map fpr CCs.callerSaveFRegs
245 :     | "ccall-bare" => []
246 :     | conv => raise Fail (concat [
247 :     "unknown calling convention \"", String.toString conv, "\""
248 :     ])
249 :     (* end case *))
250 :     val uses = List.map gpr gprUses @ List.map fpr fprUses
251 :     val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}
252 :     val (resultRegs, copyResult) = returnVals(resLocs)
253 :     val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult
254 :     in
255 :     {callseq=callSeq, result=resultRegs}
256 : mrainey 3038 end
257 : mrainey 3037
258 :     end (* AMD64SVIDFn *)

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