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/c-call/archs/x86-64-svid-fn.sml
ViewVC logotype

Annotation of /MLRISC/trunk/c-call/archs/x86-64-svid-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3166 - (view) (download)

1 : mrainey 3139 (* x86-64-svid-fn.sml
2 :     *
3 : mrainey 3160 * C calling-sequence generator for x86-64.
4 : mrainey 3139 *
5 :     * Mike Rainey (mrainey@cs.uchicago.edu)
6 :     *)
7 :    
8 :     functor X86_64SVIDFn (
9 :     structure T : MLTREE
10 : mrainey 3160 ) : C_CALL = struct
11 : mrainey 3139
12 :     structure T = T
13 :     structure C = AMD64Cells
14 :     structure CB = CellsBasis
15 :     structure CTy = CTypes
16 :    
17 :     val wordTy = 64
18 :     val mem = T.Region.memory
19 :     val stack = T.Region.stack
20 :    
21 :     fun lit i = T.LI (T.I.fromInt (wordTy, i))
22 :     fun gpr r = T.GPR (T.REG (wordTy, r))
23 :     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
24 :     fun sum ls = List.foldl (op +) 0 ls
25 :     fun szBOfCTy cTy = #sz (CSizes.sizeOfTy cTy)
26 :     fun alignBOfCTy cTy = #align (CSizes.sizeOfTy cTy)
27 :     val spReg = T.REG (wordTy, C.rsp)
28 :     fun offSp 0 = spReg
29 :     | offSp offset = T.ADD (wordTy, spReg, T.LI offset)
30 :    
31 :     structure CCall = CCallFn (
32 :     structure T = T
33 :     structure C = C
34 :     val wordTy = wordTy
35 :     val offSp = offSp)
36 :    
37 :     datatype c_arg = datatype CCall.c_arg
38 :     datatype arg_location = datatype CCall.arg_location
39 :    
40 :     datatype loc_kind = datatype CLocKind.loc_kind
41 :    
42 :     structure SA = StagedAllocationFn (
43 :     type reg_id = T.reg
44 :     datatype loc_kind = datatype loc_kind
45 :     val memSize = 8 (* bytes *))
46 :    
47 :     structure CCs = X86_64CConventionFn (
48 :     structure SA = SA
49 :     type reg_id = T.reg
50 :     val rax = C.rax
51 :     val rdi = C.rdi
52 :     val rsi = C.rsi
53 :     val rdx = C.rdx
54 :     val rcx = C.rcx
55 :     val r8 = C.r8
56 :     val r9 = C.r9
57 :     val xmm0 = C.xmm0
58 :     val xmm1 = C.xmm1
59 :     val xmm2 = C.xmm2
60 :     val xmm3 = C.xmm3
61 :     val xmm4 = C.xmm4
62 :     val xmm5 = C.xmm5
63 :     val xmm6 = C.xmm6
64 :     val xmm7 = C.xmm7)
65 :    
66 :     fun toGpr r = (wordTy, r)
67 :     fun toGprs gprs = List.map toGpr gprs
68 :     fun toFpr r = (64, r)
69 :     fun toFprs fprs = List.map toFpr fprs
70 :    
71 :     val calleeSaveRegs = [C.rbx, C.r12, C.r13, C.r14, C.r15]
72 :     val callerSaveRegs = [C.rax, C.rcx, C.rdx, C.rsi, C.rdi, C.r8, C.r9, C.r10, C.r11]
73 :     val callerSaveFRegs = (C.Regs CB.FP {from=0, to=15, step=1})
74 :     val calleeSaveFRegs = []
75 :    
76 :     val frameAlignB = 16
77 :    
78 :     val calleeSaveRegs' = toGprs calleeSaveRegs
79 :     val callerSaveRegs' = toGprs callerSaveRegs
80 :     val calleeSaveFRegs' = toFprs calleeSaveFRegs
81 :     val callerSaveFRegs' = toFprs callerSaveFRegs
82 :    
83 :     (* convert a list of C types to a list of eight bytes *)
84 :     fun eightBytesOfCTys ([], [], ebs) = List.rev (List.map List.rev ebs)
85 :     | eightBytesOfCTys ([], eb, ebs) = List.rev (List.map List.rev (eb :: ebs))
86 :     | eightBytesOfCTys (cTy :: cTys, eb, ebs) = let
87 :     val szTy = szBOfCTy cTy
88 :     val szEb = sum(List.map szBOfCTy eb)
89 :     in
90 :     if szTy + szEb = 8
91 :     then eightBytesOfCTys(cTys, [], (cTy :: eb) :: ebs)
92 :     else if szTy + szEb < 8
93 :     then eightBytesOfCTys(cTys, cTy :: eb, ebs)
94 :     else eightBytesOfCTys(cTys, [cTy], eb :: ebs)
95 :     end
96 :    
97 :     (* convert a C type into its eight bytes *)
98 :     fun eightBytesOfCTy cTy = eightBytesOfCTys (CTypes.flattenCTy cTy, [], [])
99 :    
100 :     (* classify a C type into its location kind (assuming that aggregates cannot be passed in registers) *)
101 :     fun kindOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = FPR
102 :     | kindOfCTy (CTy.C_ARRAY _ | CTy.C_STRUCT _ | CTy.C_UNION _) = raise Fail "impossible"
103 :     | kindOfCTy (CTy.C_unsigned _ | CTy.C_signed _ | CTy.C_PTR) = GPR
104 :    
105 :     fun combineKinds (k1, k2) = if (k1 = k2)
106 :     then k1
107 :     else (case (k1, k2)
108 :     of (STK, _) => STK
109 :     | (_, STK) => STK
110 :     | (GPR, _) => GPR
111 :     | (_, GPR) => GPR
112 :     | _ => FPR
113 :     (* end case*))
114 :    
115 :     (* this part of the ABI is tricky. if the eightbyte contains all floats, we use fprs, but
116 :     * otherwise we use gprs. *)
117 :     fun kindOfEightByte [] = raise Fail "impossible"
118 :     | kindOfEightByte [cTy] = kindOfCTy cTy
119 :     | kindOfEightByte (cTy1 :: cTy2 :: cTys) = let
120 :     val k1 = combineKinds (kindOfCTy cTy1, kindOfCTy cTy2)
121 :     val k2 = kindOfEightByte(cTy2 :: cTys)
122 :     in
123 :     combineKinds(k1, k2)
124 :     end
125 :    
126 :     fun containsUnalignedFields cTy = (case cTy
127 :     of (CTy.C_STRUCT cTys | CTy.C_UNION cTys) => List.exists containsUnalignedFields cTys
128 :     | cTy => Int.max(8, szBOfCTy cTy) mod 8 <> 0
129 :     (* end case *))
130 :    
131 :     fun reqsOfCTy (cTy as (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _)) =
132 :     if (szBOfCTy cTy > 2*8 orelse containsUnalignedFields cTy)
133 :     then List.tabulate (szBOfCTy cTy div 8, fn _ => (8*8, STK, 8))
134 :     else List.map (fn eb => (8*8, kindOfEightByte eb, 8)) (eightBytesOfCTy cTy)
135 :     | reqsOfCTy cTy = [(8*szBOfCTy cTy, kindOfCTy cTy, alignBOfCTy cTy)]
136 :    
137 :     fun reqOfCTy cTy = (case reqsOfCTy cTy
138 :     of [req] => req
139 :     | _ => raise Fail "malformed C type"
140 :     (* end case *))
141 :    
142 :     (* convert staged allocation locations to C locations *)
143 : mrainey 3166 fun locToC (SA.NARROW (SA.REG (_, GPR, r), w, GPR)) =
144 :     CCall.C_GPR (w, r)
145 :     | locToC (SA.NARROW (SA.REG (_, FPR, r), w, FPR)) =
146 :     CCall.C_FPR (w, r)
147 :     | locToC (SA.NARROW (SA.BLOCK_OFFSET (_, (GPR | FPR | STK | FSTK), offB), w, (GPR | FPR | STK | FSTK))) =
148 : mrainey 3139 CCall.C_STK (w, T.I.fromInt (wordTy, offB))
149 :     | locToC _ = raise Fail "impossible"
150 :    
151 :     (* given a return type, return the locations for the return values *)
152 :     fun layoutReturn retTy = (case retTy
153 :     of CTy.C_void => ([], NONE, CCs.store0)
154 :     | retTy => let
155 :     val (locs, store) = SA.allocateSeq CCs.returns (reqsOfCTy retTy, CCs.store0)
156 :     val {sz, align} = CSizes.sizeOfTy retTy
157 :     in
158 :     (List.map locToC locs, SOME {szb=sz, align=align}, store)
159 :     end
160 :     (* end case *))
161 :    
162 :     (* given a store and some parameters, return the C locations for those parameters *)
163 :     fun layoutCall (store, paramTys) = let
164 :     val paramReqs = List.map reqsOfCTy paramTys
165 :     val (paramLocss, store) = SA.allocateSeqs CCs.params (paramReqs, store)
166 :     val paramCLocss = List.map (List.map locToC) paramLocss
167 :     in
168 :     (paramCLocss, store)
169 :     end
170 :    
171 :     fun layout {conv, retTy, paramTys} = let
172 :     val (resLocs, structRetLoc, store) = layoutReturn retTy
173 :     val (paramLocss, store) = layoutCall(store, paramTys)
174 :     (* number of bytes allocated for the call *)
175 :     val frameSzB = SA.find(store, CCs.cCallStk)
176 :     val argMem = {szb=CSizes.alignAddr(frameSzB, frameAlignB), align=frameAlignB}
177 :     in
178 :     {argLocs=paramLocss, argMem=argMem, structRetLoc=structRetLoc, resLocs=resLocs}
179 :     end
180 :    
181 :     (* copy the return value into the result location *)
182 :     fun returnVals resLocs = (case resLocs
183 :     of [] => ([], [])
184 :     | [CCall.C_GPR (ty, r)] => let
185 :     val resReg = C.newReg ()
186 :     in
187 :     ([T.GPR (T.REG (ty, resReg))],
188 :     [T.COPY (ty, [resReg], [r])])
189 :     end
190 :     | [CCall.C_FPR (ty, r)] => let
191 :     val resReg = C.newFreg ()
192 :     in
193 :     ([T.FPR (T.FREG (ty, resReg))],
194 :     [T.FCOPY (ty, [resReg], [r])])
195 :     end
196 :     (* end case *))
197 :    
198 :     fun genCall {name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args} = let
199 :     val {argLocs, argMem, resLocs, structRetLoc} = layout(proto)
200 :     val argAlloc = if ((#szb argMem = 0) orelse paramAlloc argMem)
201 :     then []
202 :     else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,
203 :     T.LI (T.I.fromInt (wordTy, #szb argMem))))]
204 :     val (copyArgs, gprUses, fprUses) = CCall.copyArgs(args, argLocs)
205 :     (* the defined registers of the call depend on the calling convention *)
206 :     val defs = (case #conv proto
207 :     of "ccall" => List.map (gpr o #2) callerSaveRegs' @ List.map fpr callerSaveFRegs'
208 :     | "ccall-bare" => []
209 :     | conv => raise Fail (concat [
210 :     "unknown calling convention \"", String.toString conv, "\""
211 :     ])
212 :     (* end case *))
213 :     val uses = List.map gpr gprUses @ List.map fpr fprUses
214 :     val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}
215 :     val (resultRegs, copyResult) = returnVals(resLocs)
216 :     val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult
217 :     in
218 :     {callseq=callSeq, result=resultRegs}
219 :     end
220 :    
221 :     end (* X86_64SVIDFn *)

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