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 /sml/trunk/src/MLRISC/ppc/c-calls/ppc-macosx.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/ppc/c-calls/ppc-macosx.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1523 - (view) (download)

1 : jhr 1346 (* ppc-macosx.sml
2 :     *
3 :     * COPYRIGHT (c) 2003 John Reppy (http://www.cs.uchicago.edu/~jhr)
4 :     * All rights reserved.
5 :     *
6 :     * C function calls for the PowerPC using the MacOS X ABI.
7 :     *
8 :     * Register conventions:
9 :     *
10 :     * Register Callee-save Purpose
11 :     * -------- ----------- -------
12 :     * GPR0 no Zero
13 :     * 1 no Stack pointer
14 :     * 2 no scratch (TOC on AIX)
15 :     * 3 no arg0 and return result
16 :     * 4-10 no arg1-arg7
17 :     * 11 no scratch
18 :     * 12 no holds taget of indirect call
19 :     * 13-31 yes callee-save registers
20 :     *
21 :     * FPR0 no scratch
22 :     * 1-13 no floating-point arguments
23 :     * 14-31 yes floating-point callee-save registers
24 :     *
25 :     * V0-V1 no scratch vector registers
26 :     * 2-13 no vector argument registers
27 :     * 14-19 no scratch vector registers
28 :     * 20-31 yes callee-save vector registers
29 :     *
30 :     * LR no link register holds return address
31 :     *
32 :     * CR0-CR1 no scratch condition registers
33 :     * 2-4 yes callee-save condition registers
34 :     * 5-7 no scratch condition registers
35 :     *
36 :     * Calling convention:
37 :     *
38 :     * Return result:
39 :     * + Integer and pointer results are returned in GPR3
40 :     * + 64-bit integers (long long) returned in GPR3/GPR4
41 :     * + float/double results are returned in FPR1
42 :     * + Struct results are returned in space provided by the caller.
43 :     * The address of this space is passed to the callee as an
44 :     * implicit first argument in GPR3 and the first real argument is
45 :     * passed in GPR4.
46 :     *
47 :     * Function arguments:
48 :     * * arguments (except for floating-point values) are passed in
49 :     * registers GPR3-GPR10
50 : jhr 1438 *
51 :     * Note also that stack frames are supposed to be 16-byte aligned.
52 : jhr 1346 *)
53 :    
54 :     (* we extend the interface to support generating the stubs needed for
55 :     * dynamic linking (see "Inside MacOS X: Mach-O Runtime Architecture"
56 :     * for details.
57 :     *)
58 :     signature PPC_MACOSX_C_CALLS =
59 :     sig
60 :     include C_CALLS
61 : jhr 1438
62 :     (*
63 :     val genStub : {
64 :     name : T.rexp,
65 :     proto : CTypes.c_proto,
66 :     paramAlloc : {szb : int, align : int} -> bool,
67 :     structRet : {szb : int, align : int} -> T.rexp,
68 :     saveRestoreDedicated :
69 :     T.mlrisc list -> {save: T.stm list, restore: T.stm list},
70 :     callComment : string option,
71 :     args : c_arg list
72 :     } -> {
73 :     callseq : T.stm list,
74 :     result: T.mlrisc list
75 :     }
76 :     *)
77 :    
78 : jhr 1346 end;
79 :    
80 :     functor PPCMacOSX_CCalls (
81 :    
82 :     structure T : MLTREE
83 :     val ix : (T.stm, T.rexp, T.fexp, T.ccexp) PPCInstrExt.sext -> T.sext
84 :    
85 :     ): PPC_MACOSX_C_CALLS = struct
86 :     structure T = T
87 : jhr 1521 structure CTy = CTypes
88 : jhr 1346 structure C = PPCCells
89 :     structure IX = PPCInstrExt
90 :    
91 :     fun error msg = MLRiscErrorMsg.error ("PPCCompCCalls", msg)
92 :    
93 : jhr 1521 (* the location of arguments/parameters; offsets are given with respect to the
94 :     * low end of the parameter area.
95 :     *)
96 :     datatype arg_location
97 : jhr 1522 = Reg of T.ty * T.reg * T.I.machine_int option
98 :     (* integer/pointer argument in register *)
99 :     | FReg of T.fty * T.freg * T.I.machine_int option
100 :     (* floating-point argument in register *)
101 : jhr 1521 | Stk of T.ty * T.I.machine_int (* integer/pointer argument in parameter area *)
102 :     | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
103 :     | Args of arg_location list
104 :    
105 : jhr 1522 val wordTy = 32
106 :     val fltTy = 32 (* MLRISC type of float *)
107 :     val dblTy = 64 (* MLRISC type of double *)
108 : jhr 1346
109 : jhr 1523 (* stack pointer *)
110 :     val sp = C.GPReg 1
111 :     val spR = T.REG(wordTy, sp)
112 :    
113 : jhr 1521 (* registers used for parameter passing *)
114 :     val argGPRs = List.map C.GPReg [3, 4, 5, 6, 7, 8, 9, 10]
115 :     val argFPRs = List.map C.FPReg [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13]
116 : jhr 1522 val resGPR = C.GPReg 3
117 :     val resFPR = C.FPReg 1
118 : jhr 1521
119 :     (* C callee-save registers *)
120 :     val calleeSaveRegs = List.map C.GPReg [
121 :     13, 14, 15, 16, 17, 18, 19, 20, 21, 22,
122 :     23, 24, 25, 26, 27, 28, 29, 30, 31
123 :     ]
124 :     val calleeSaveFRegs = List.map C.FPReg [
125 :     14, 15, 16, 17, 18, 19, 20, 21, 22,
126 :     23, 24, 25, 26, 27, 28, 29, 30, 31
127 :     ]
128 :    
129 : jhr 1523 (* C caller-save registers (including argument registers) *)
130 :     val callerSaveRegs =
131 :     (* FIXME: also need link register *)
132 :     (List.map C.GPReg [2, 11, 12]) @ argGPRs @ (List.map C.FPReg [0]) @ argFPRs
133 :    
134 : jhr 1522 (* size and padding for integer types. Note that the padding is based on the
135 :     * parameter-passing description on p. 35 of the documentation.
136 :     *)
137 : jhr 1521 fun sizeOf CTy.I_char = {sz = 1, pad = 3}
138 :     | sizeOf CTy.I_short = {sz = 2, pad = 2}
139 :     | sizeOf CTy.I_int = {sz = 4, pad = 0}
140 :     | sizeOf CTy.I_long = {sz = 4, pad = 0}
141 :     | sizeOf CTy.I_long_long = {sz = 8, pad = 0}
142 :    
143 : jhr 1522 (* sizes of other C types *)
144 :     val sizeOfPtr = {sz = 4, pad = 0}
145 :    
146 : jhr 1523 fun sizeOfStruct tys = ?
147 : jhr 1522
148 : jhr 1521 (* compute the layout of a C call's arguments *)
149 :     fun layout {conv, retTy, paramTys} = let
150 : jhr 1522 fun gprRes isz = (case sizeOf isz
151 :     of 8 => raise Fail "register pairs not yet supported"
152 :     | _ => SOME resGPR
153 : jhr 1521 (* end case *))
154 : jhr 1522 val (resReg, availGPRs) = (case retTy
155 :     of CTy.C_void => (NONE, availGPRs)
156 :     | CTy.C_float => (SOME resFPR, availGPRs)
157 :     | CTy.C_double => (SOME resFPR, availGPRs)
158 :     | CTy.C_long_double => (SOME resFPR, availGPRs)
159 :     | CTy.C_unsigned isz => (gprRes isz, availGPRs)
160 :     | CTy.C_signed isz => (gprRes isz, availGPRs)
161 :     | CTy.C_PTR => (SOME resGPR, availGPRs)
162 :     | CTy.C_ARRAY _ => error "array return type"
163 :     | CTy.C_STRUCT s => let
164 :     val sz = sizeOfStruct s
165 :     in
166 :     (* Note that this is a place where the MacOS X and Linux ABIs differ.
167 :     * In Linux, GPR3/GPR4 are used to return composite values of 8 bytes.
168 :     *)
169 :     if (sz > 4)
170 :     then (SOME resGPR, List.tl availGPRs)
171 :     else (SOME resGPR, availGPRs)
172 :     end
173 :     (* end case *))
174 : jhr 1521 fun assign ([], offset, _, _, layout) = {sz = offset, layout = List.rev layout}
175 :     | assign (arg::args, offset, availGPRs, availFPRs, layout) = (
176 :     case arg
177 :     of CTy.C_void => error "unexpected void argument type"
178 : jhr 1522 | CTy.C_float => (case (availGPRs, availFPRs)
179 :     of (_:gprs, fpr::fprs) =>
180 :     assign (args, offset+4, gprs, fprs, FReg(fltTy, fpr, SOME offset)::layout)
181 :     | ([], fpr::fprs) =>
182 :     assign (args, offset+4, [], fprs, FReg(fltTy, fpr, SOME offset)::layout)
183 :     | ([], []) =>
184 :     assign (args, offset+4, [], [], FStk(fltTy, offset)::layout)
185 :     (* end case *))
186 : jhr 1521 | CTy.C_double =>
187 :     | CTy.C_long_double =>
188 :     | CTy.C_unsigned isz =>
189 : jhr 1522 assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)
190 : jhr 1521 | CTy.C_signed isz =>
191 : jhr 1522 assignGPR(sizeOf isz, args, offset, availGPRs, availFPRs, layout)
192 : jhr 1521 | CTy.C_PTR =>
193 : jhr 1522 assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)
194 : jhr 1521 | CTy.C_ARRAY _ =>
195 : jhr 1522 assignGPR(sizeOfPtr, args, offset, availGPRs, availFPRs, layout)
196 : jhr 1521 | CTy.C_STRUCT tys =>
197 :     (* end case *))
198 : jhr 1522 (* assign a GP register and memory for an integer/pointer argument. *)
199 :     and assignGPR ({sz, pad}, args, offset, availGPRs, availFPRs, layout) = let
200 :     val (loc, availGPRs) = (case (sz, availGPRs)
201 :     of (8, _) => raise Fail "register pairs not yet supported"
202 :     | (_, []) => (Stk(wordTy, offset), [])
203 :     | (_, r1::rs) => (Reg(wordTy, r1, SOME offset), rs)
204 :     (* end case *))
205 :     val offset = offset + sz + pad
206 : jhr 1521 in
207 : jhr 1522 assign (args, offset, availGPRs, availFPRs, loc::layout)
208 : jhr 1521 end
209 : jhr 1522 (* assign a FP register and memory/GPRs for double-precision argument. *)
210 :     and assignFPR (args, offset, availGPRs, availFPRs, layout) = let
211 :     fun continue (availGPRs, availFPRs, loc) =
212 :     assign (args, offset+8, availGPRs, availFPRs, loc::layout)
213 :     fun freg fpr = FReg(dblTy, fpr, SOME offset)
214 :     in
215 :     case (availGPRs, availFPRs)
216 :     of (_::_::gprs, fpr::fprs) => continue (gprs, fprs, freg fpr)
217 :     | (_, fpr::fprs) => continue ([], fprs, freg fpr)
218 :     | ([], []) => continue ([], [], FStk(dblTy, offset))
219 :     (* end case *)
220 :     end
221 : jhr 1523 in {
222 :     argLocs = assign (paramTys, 0, argGPRs, argFPRs, []),
223 :     resLoc = resReg,
224 :     structRet = ?
225 :     } end
226 : jhr 1521
227 : jhr 1346 datatype c_arg
228 :     = ARG of T.rexp
229 :     | FARG of T.fexp
230 :     | ARGS of c_arg list
231 :    
232 : jhr 1523 val memRg = T.Region.memory
233 :     val stkRg = T.Region.memory
234 : jhr 1346
235 : jhr 1445 fun genCall {
236 :     name, proto, paramAlloc, structRet, saveRestoreDedicated,
237 :     callComment, args
238 :     } = let
239 :     val {conv, retTy, paramTys} = proto
240 : jhr 1523 val {argLocs, resLoc, structRet} = layout proto
241 :     (* generate code to assign the arguments to their locations *)
242 :     fun assignArgs ([], [], stms) = stms
243 :     | assignArgs (Reg(ty, r, _) :: locs, ARG exp :: args, stms) =
244 :     assignArgs (locs, args, T.MV(ty, r, exp) :: stms)
245 :     | assignArgs (Stk(ty, off) :: locs, ARG exp :: args, stms) =
246 :     assignArgs (locs, args, T.STORE(ty, ?, exp, stkRg) :: stms)
247 :     | assignArgs (FReg(ty, r, _) :: locs, FARG fexp :: args) =
248 :     assignArgs (locs, args, T.FMV(ty, r, fexp) :: stms)
249 :     | assignArgs (FStk(ty, off) :: locs, FARG fexp :: args, stms) =
250 :     assignArgs (locs, args, T.FSTORE(ty, ?, fexp, stkRg) :: stms)
251 :     | assignArgs ((Args locs') :: locs, (ARGS args') :: args, stms) =
252 :     assignArgs (locs, args, assignArgs(locs', args', stms))
253 :     | assignArgs _ = error "argument/formal mismatch"
254 :     val argsetupCode = List.rev(assignArgs(args, args, []))
255 :     (* convert the result location to an MLRISC expression list *)
256 :     val result = (case resLoc
257 :     of NONE => []
258 :     | SOME(Reg(ty, r, _)) => [T.REG(ty, r)]
259 :     | SOME(FReg(ty, r, _)) => [T.FREG(ty, r)]
260 :     | SOME _ => raise Fail "bogus result location"
261 :     (* end case *))
262 :     (* determine the registers used and defined by this call *)
263 :     val (uses, defs) = let
264 :     val locs = (case resLoc
265 :     of NONE => argLocs
266 :     | SOME loc => loc::argLocs
267 :     (* end case *))
268 :     (* get the list of registers used to pass arguments and results *)
269 :     fun addArgReg (Reg(ty, r, _)::locs, argRegs) =
270 :     addArgReg (locs, T.GPR(T.REG(ty, r))::argRegs)
271 :     | addArgReg (FReg(ty, r, _)::locs, argRegs) =
272 :     addArgReg (locs, T.FPR(T.FREG(ty, r))::argRegs)
273 :     | addArgReg ((Args locs')::locs, argRegs) =
274 :     addArgReg (locs, addArgReg(locs', argRegs))
275 :     | addArgReg (_::locs, argRegs) = addArgReg(locs, argRegs)
276 :     val argRegs = addArgReg (locs, [])
277 :     in
278 :     (argRegs, callerSaveRegs)
279 :     end
280 :     (* the actual call instruction *)
281 :     val callStm = T.CALL {
282 :     funct = name, targets = [],
283 :     defs = defs, uses = uses,
284 :     region = memRg, pops = 0
285 :     }
286 :     (* annotate, if necessary *)
287 :     val callStm = (case callComment
288 :     of NONE => callStm
289 :     | SOME c => T.ANNOTATION(callStm, #create MLRiscAnnotations.COMMENT c)
290 :     (* end case *))
291 : jhr 1445 val callseq = List.concat [
292 : jhr 1523 ??,
293 :     argSetupCode,
294 :     [callStm],
295 :     ??
296 : jhr 1445 ]
297 :     in
298 :     (* check calling convention *)
299 :     case conv
300 :     of ("" | "ccall") => ()
301 :     | _ => error (concat [
302 :     "unknown calling convention \"",
303 :     String.toString conv, "\""
304 :     ])
305 :     (* end case *);
306 :     {callseq = callseq, result = result}
307 :     end
308 : jhr 1346
309 : jhr 1445 end

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