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/x86/c-calls/ia32-svid.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/x86/c-calls/ia32-svid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1523 - (view) (download)

1 : george 559 (* ia32-svid.sml
2 :     *
3 :     * COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
4 :     *
5 : george 600 * C function calls for the IA32 using the System V ABI
6 : george 559 *
7 :     * Register conventions:
8 :     *
9 : leunga 695 * %eax return value (caller save)
10 : george 559 * %ebx global offset for PIC (callee save)
11 :     * %ecx scratch (caller save)
12 :     * %edx extra return/scratch (caller save)
13 :     * %ebp optional frame pointer (callee save)
14 :     * %esp stack pointer (callee save)
15 :     * %esi locals (callee save)
16 :     * %edi locals (callee save)
17 :     *
18 :     * %st(0) top of FP stack; FP return value
19 :     * %st(1..7) FP stack; must be empty on entry and return
20 :     *
21 :     * Calling convention:
22 :     *
23 :     * Return result:
24 :     * + Integer and pointer results are returned in %eax
25 :     * + 64-bit integers (long long) returned in %eax/%edx
26 :     * + Floating point results are returned in %st(0) (all types).
27 :     * + Struct results are returned in space provided by the caller.
28 :     * The address of this space is passed to the callee as an
29 :     * implicit 0th argument, and on return %eax contains this
30 :     * address.
31 :     *
32 :     * Function arguments:
33 :     * + Arguments are pushed on the stack right to left.
34 :     * + Integral and pointer arguments take one word on the stack.
35 :     * + float arguments take one word on the stack.
36 :     * + double arguments take two words on the stack. The i386 ABI does
37 :     * not require double word alignment for these arguments.
38 :     * + long double arguments take three words on the stack.
39 :     * + struct arguments are padded out to word length.
40 :     *
41 :     * Questions:
42 :     * - what about stack frame alignment?
43 :     *)
44 :    
45 : jhr 1043 functor IA32SVID_CCalls (
46 :     structure T : MLTREE
47 :     val ix : (T.stm,T.rexp,T.fexp,T.ccexp) X86InstrExt.sext -> T.sext
48 :     (* Note that the fast_loating_point flag must match the one passed
49 :     * to the code generator module.
50 :     *)
51 :     val fast_floating_point : bool ref
52 :     ) : C_CALLS = struct
53 : george 559
54 : jhr 1043 structure T = T
55 :     structure Ty = CTypes
56 :     structure C = X86Cells
57 :     structure IX = X86InstrExt
58 : george 559
59 : jhr 1043 fun error msg = MLRiscErrorMsg.error ("X86CompCCalls", msg)
60 : blume 777
61 : jhr 1043 datatype c_arg
62 :     = ARG of T.rexp
63 :     | FARG of T.fexp
64 :     | ARGS of c_arg list
65 :    
66 :     val mem = T.Region.memory
67 :     val stack = T.Region.memory
68 :    
69 :     val paramAreaOffset = 0 (* stack offset to param area *)
70 :    
71 : leunga 972 (* This annotation is used to indicate that a call returns a fp value
72 :     * in %st(0)
73 :     *)
74 : jhr 1043 val fpReturnValueInST0 = #create MLRiscAnnotations.RETURN_ARG C.ST0
75 : leunga 972
76 : george 823 (* map C integer types to their MLRisc type *)
77 : jhr 1043 fun intTy (Ty.I_char) = 8
78 :     | intTy (Ty.I_short) = 16
79 :     | intTy (Ty.I_int) = 32
80 :     | intTy (Ty.I_long) = 32
81 :     | intTy (Ty.I_long_long) = 64
82 : george 600
83 : george 823 (* size in bytes of C integer type *)
84 : jhr 1043 fun intSize (Ty.I_char) = 1
85 :     | intSize (Ty.I_short) = 2
86 :     | intSize (Ty.I_int) = 4
87 :     | intSize (Ty.I_long) = 4
88 :     | intSize (Ty.I_long_long) = 8
89 : george 600
90 : george 823 (* size in bytes of C type *)
91 : jhr 1043 fun sizeOf (Ty.C_void) = 4
92 :     | sizeOf (Ty.C_float) = 4
93 :     | sizeOf (Ty.C_double) = 8
94 :     | sizeOf (Ty.C_long_double) = 12 (* no padding required *)
95 :     | sizeOf (Ty.C_unsigned i) = intSize i
96 :     | sizeOf (Ty.C_signed i) = intSize i
97 :     | sizeOf (Ty.C_PTR) = 4
98 :     | sizeOf (Ty.C_ARRAY _) = 4
99 :     | sizeOf (Ty.C_STRUCT fields) = structSz fields
100 : george 600
101 : george 823 (* size in bytes of C struct type *)
102 : jhr 1043 and structSz fields =
103 :     List.foldl (fn (fld, sum) => sizeOf fld + sum) 0 fields
104 : george 608
105 : jhr 1043 val sp = C.esp
106 :     fun LI i = T.LI(T.I.fromInt(32, i))
107 : george 600
108 : jhr 1043 local
109 :     fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
110 :     fun gpr(sz,r) = T.GPR(T.REG(sz, r))
111 :     val st0 = C.ST(0)
112 :     (* note that the caller saves includes the result register (%eax) *)
113 :     val callerSaves = [gpr(32, C.eax), gpr(32, C.ecx), gpr(32, C.edx)]
114 :     val oneRes = [gpr(32, C.eax)]
115 :     val twoRes = [gpr(32, C.edx), gpr(32, C.eax)]
116 :     in
117 :     (* List of registers defined by a C Call; this is the result registers
118 : jhr 1523 * plus the caller-save registers.
119 : jhr 1043 * Multiple returns have most significant register first.
120 :     *)
121 : george 823 fun resultsAndDefs (Ty.C_void) = ([], callerSaves)
122 :     | resultsAndDefs (Ty.C_float) =
123 :     ([fpr(32, st0)], fpr(32, st0) :: callerSaves)
124 :     | resultsAndDefs (Ty.C_double) =
125 :     ([fpr(64, st0)], fpr(64, st0) :: callerSaves)
126 :     | resultsAndDefs (Ty.C_long_double) =
127 :     ([fpr(80, st0)], fpr(80, st0) :: callerSaves)
128 :     | resultsAndDefs (Ty.C_unsigned(Ty.I_long_long)) =
129 :     (twoRes, gpr(32, C.edx) :: callerSaves)
130 :     | resultsAndDefs (Ty.C_signed(Ty.I_long_long)) =
131 :     (twoRes, gpr(32, C.edx) :: callerSaves)
132 :     | resultsAndDefs (Ty.C_unsigned i) = (oneRes, callerSaves)
133 :     | resultsAndDefs (Ty.C_signed i) = (oneRes, callerSaves)
134 :     | resultsAndDefs (Ty.C_PTR) = (oneRes, callerSaves)
135 :     | resultsAndDefs (Ty.C_ARRAY _) = (oneRes, callerSaves)
136 :     | resultsAndDefs (Ty.C_STRUCT _) = (oneRes, callerSaves)
137 : george 600
138 : jhr 1521 (**** START NEW CODE ****)
139 :    
140 :     (* the location of arguments/parameters; offsets are given with respect to the
141 :     * low end of the parameter area (see paramAreaOffset above).
142 :     *)
143 :     datatype arg_location
144 : jhr 1523 = Reg of T.ty * T.reg * T.I.machine_int option
145 :     (* integer/pointer argument in register *)
146 :     | FReg of T.fty * T.freg * T.I.machine_int option
147 :     (* floating-point argument in register *)
148 : jhr 1521 | Stk of T.ty * T.I.machine_int (* integer/pointer argument in parameter area *)
149 :     | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
150 :     | Args of arg_location list
151 :    
152 :     fun layout {conv, retTy, paramTys} = let
153 :     in
154 :     raise Fail "layout not implemented yet"
155 :     end
156 :    
157 :     (* C callee-save registers *)
158 :     val calleeSaveRegs = [C.ebx, C.esi, C.edi] (* C callee-save registers *)
159 :     val calleeSaveFRegs = [] (* C callee-save floating-point registers *)
160 :    
161 :     (**** END NEW CODE ****)
162 :    
163 : jhr 1043 fun fstp (32, f) = T.EXT(ix(IX.FSTPS(f)))
164 :     | fstp (64, f) = T.EXT(ix(IX.FSTPL(f)))
165 :     | fstp (80, f) = T.EXT(ix(IX.FSTPT(f)))
166 : mblume 1334 | fstp (sz, f) = error ("fstp(" ^ Int.toString sz ^ ",_)")
167 : george 559
168 : jhr 1043 (* Copy (result) registers into fresh temporaries *)
169 : george 823 fun copyOut([], results, stmts) = (results, stmts)
170 :     | copyOut (T.FPR(T.FREG(sz, f))::rest, results, stmts) = let
171 :     val t = C.newFreg()
172 : jhr 1043 (* If we are using fast floating point mode then do NOT
173 :     * generate FSTP.
174 :     * --- Allen
175 :     *)
176 :     val stmt = if !fast_floating_point
177 :     then T.FCOPY(sz, [t], [f])
178 :     else fstp(sz, T.FREG(sz, t))
179 :     in
180 :     copyOut (rest, fpr(sz, t)::results, stmt::stmts)
181 :     end
182 : george 823 | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let
183 :     val t = C.newReg()
184 : jhr 1043 in
185 :     copyOut(rest, gpr(sz, t)::results, T.COPY(sz,[t],[r])::stmts)
186 :     end
187 : george 823 | copyOut _ = error "copyOut"
188 : jhr 1043 end (* local *)
189 : george 600
190 : jhr 1043 fun genCall ar = let
191 :     val {
192 :     name, proto, paramAlloc, structRet,
193 :     saveRestoreDedicated, callComment, args
194 :     } = ar
195 :     val {conv, retTy, paramTys} = proto
196 :     val calleePops = (case conv
197 :     of (""|"ccall") => false
198 :     | "stdcall" => true
199 :     | _ => error (concat [
200 :     "unknown calling convention \"", String.toString conv, "\""
201 :     ])
202 :     (* end case *))
203 :     fun push signed {sz, e} = let
204 :     fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))
205 :     fun signExtend(e) = if sz=32 then e else T.SX(32, sz, e)
206 :     fun zeroExtend(e) = if sz=32 then e else T.ZX(32, sz, e)
207 :     in
208 :     pushl(if signed then signExtend(e) else zeroExtend(e))
209 :     end
210 :     val signed = push true
211 :     val unsigned = push false
212 : george 559
213 : jhr 1043 fun push64 rexp = error "push64"
214 :     (* increment the stack pointer and store floating point result. *)
215 :     fun bumpSp sz = T.MV(32, sp, T.SUB(32, T.REG(32,sp), LI sz))
216 :     fun storeAtSp(sz, e) = T.STORE(sz, T.REG(32,sp), e, stack)
217 :     fun PUSHB(e, stmts) = bumpSp(1)::storeAtSp(8, e)::stmts
218 :     fun PUSHW(e, stmts) = bumpSp(2)::storeAtSp(16, e)::stmts
219 : george 559
220 : jhr 1043 fun fst32 fexp = [bumpSp(4), T.FSTORE(32, T.REG(32, sp), fexp, stack)]
221 :     fun fst64 fexp = [bumpSp(8), T.FSTORE(64, T.REG(32, sp), fexp, stack)]
222 :     fun fst80 fexp = [bumpSp(10), T.FSTORE(80, T.REG(32, sp), fexp, stack)]
223 : george 559
224 : jhr 1043 fun pushArgs ([], [], stmts) = stmts
225 :     | pushArgs (param::r1, arg::r2, stmts) = let
226 :     fun next stmt = pushArgs (r1, r2, stmt::stmts)
227 :     fun nextL stmt = pushArgs (r1, r2, stmt@stmts)
228 :     (* struct arguments are padded to word boundaries. *)
229 :     fun pad16(fields, stmts) = let
230 :     val sz = structSz fields
231 :     in
232 :     case Word.andb(Word.fromInt sz, 0w1)
233 :     of 0w0 => stmts
234 :     | 0w1 => bumpSp(1)::stmts
235 : mblume 1334 | _ => error ("pad16: sz=" ^ Int.toString sz)
236 : jhr 1043 (*esac*)
237 : george 823 end
238 : jhr 1043 fun mkStructArgs(fields, rexp) = let
239 :     val ptrR = C.newReg()
240 :     val ptr = T.REG(32, ptrR)
241 :     fun mkArgs([], i, acc) = (i, rev acc)
242 :     | mkArgs(ty::rest, i, acc) = let
243 :     fun ea() = T.ADD(32, ptr, LI i)
244 :     fun fload (bits, bytes) =
245 :     mkArgs(rest, i+bytes,
246 :     FARG(T.FLOAD(bits, ea(), mem))::acc)
247 :     fun load (bits, bytes) =
248 :     mkArgs(rest, i+bytes,
249 :     ARG(T.LOAD(bits, ea(), mem))::acc)
250 :     fun intSz cint = (intTy cint, intSize cint)
251 :     in
252 :     case ty
253 :     of Ty.C_void => error "STRUCT: void field"
254 :     | Ty.C_float => fload(32, 4)
255 :     | Ty.C_double => fload(64, 8)
256 :     | Ty.C_long_double => fload(80, 10)
257 :     | Ty.C_unsigned(cint) => load(intSz(cint))
258 :     | Ty.C_signed(cint) => load(intSz(cint))
259 :     | Ty.C_PTR => load(32, 4)
260 :     | Ty.C_ARRAY _ => load(32, 4)
261 :     | Ty.C_STRUCT fields => let
262 :     val (i, args) = mkArgs(fields, i, [])
263 :     in mkArgs(rest, i, ARGS args::acc)
264 :     end
265 :     end
266 :     in (T.MV(32, ptrR, rexp), #2 (mkArgs(fields, 0, [])))
267 :     end
268 :     in
269 :     case (param, arg)
270 :     of (Ty.C_float, FARG fexp) => nextL(fst32 fexp)
271 :     | (Ty.C_double, FARG fexp) => nextL(fst64 fexp)
272 :     | (Ty.C_long_double, FARG fexp) => nextL(fst80 fexp)
273 :     | (Ty.C_unsigned(Ty.I_char), ARG rexp) =>
274 :     next(unsigned{sz=8, e=rexp})
275 :     | (Ty.C_unsigned(Ty.I_short), ARG rexp) =>
276 :     next(unsigned{sz=16, e=rexp})
277 :     | (Ty.C_unsigned(Ty.I_int), ARG rexp) =>
278 :     next(unsigned{sz=32, e=rexp})
279 :     | (Ty.C_unsigned(Ty.I_long), ARG rexp) =>
280 :     next(unsigned{sz=32, e=rexp})
281 :     | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) =>
282 :     next(push64(rexp))
283 :     | (Ty.C_signed(Ty.I_char), ARG rexp) => next(signed{sz=8, e=rexp})
284 :     | (Ty.C_signed(Ty.I_short), ARG rexp) => next(signed{sz=16, e=rexp})
285 :     | (Ty.C_signed(Ty.I_int), ARG rexp) => next(signed{sz=32, e=rexp})
286 :     | (Ty.C_signed(Ty.I_long), ARG rexp) => next(signed{sz=32, e=rexp})
287 :     | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)
288 :     | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})
289 :     | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})
290 :     | (Ty.C_STRUCT fields, ARG rexp) => let
291 :     val (ldPtr, args) = mkStructArgs(fields, rexp)
292 :     val stmts = pushArgs([param], [ARGS(args)], stmts)
293 :     in pushArgs(r1, r2, ldPtr::stmts)
294 :     end
295 :     | (Ty.C_STRUCT fields, ARGS args) => let
296 :     fun pushStruct([], [], stmts) = stmts
297 :     | pushStruct(ty::tys, arg::args, stmts) = let
298 :     fun cont(stmts) = pushStruct(tys, args, stmts)
299 :     fun pushf(sz, fexp) =
300 :     (case sz
301 :     of 32 => fst32(fexp)
302 :     | 64 => fst64(fexp)
303 :     | 80 => fst80(fexp)
304 : mblume 1334 | _ => error ("pushf: sz=" ^ Int.toString sz)
305 : jhr 1043 (*esac*)) @ stmts
306 :     fun pushb (rexp) = cont(PUSHB(rexp, stmts))
307 :     fun pushw (rexp) = cont(PUSHW(rexp, stmts))
308 :     fun pushl (rexp) = cont(T.EXT(ix(IX.PUSHL(rexp)))::stmts)
309 :     fun pushCint(cint, rexp) =
310 :     (case cint
311 :     of Ty.I_char => pushb(rexp)
312 :     | Ty.I_short => pushw(rexp)
313 :     | Ty.I_int => pushl(rexp)
314 :     | Ty.I_long => pushl(rexp)
315 :     | Ty.I_long_long => error "STRUCT: long_long"
316 :     (*esac*))
317 :     in
318 :     case (ty, arg)
319 :     of (Ty.C_void, _) => error "STRUCT: void field"
320 :     | (Ty.C_float, FARG fexp) => cont(pushf(32,fexp))
321 :     | (Ty.C_double, FARG fexp) => cont(pushf(64, fexp))
322 :     | (Ty.C_long_double, FARG fexp) =>
323 :     cont(pushf(80, fexp))
324 :     | (Ty.C_unsigned(cint), ARG rexp) =>
325 :     pushCint(cint, rexp)
326 :     | (Ty.C_signed(cint), ARG rexp) => pushCint(cint, rexp)
327 :     | (Ty.C_PTR, ARG rexp) => pushl(rexp)
328 :     | (Ty.C_ARRAY _, ARG rexp) => pushl(rexp)
329 :     | (Ty.C_STRUCT fields, ARG rexp) => let
330 :     val (ldPtr, args) = mkStructArgs(fields, rexp)
331 :     in cont(ldPtr::pushStruct(fields, args, stmts))
332 :     end
333 :     | (Ty.C_STRUCT fields, ARGS rexps) =>
334 :     cont(pushStruct(fields, rexps, stmts))
335 : mblume 1334 | _ => error "pushStruct: ty<->arg mismatch"
336 :     end
337 :     | pushStruct (([], _::_, _) | (_::_, [], _)) =
338 :     error "pushStruct"
339 : jhr 1043 in
340 :     pushArgs(r1, r2,
341 :     pad16(fields, pushStruct(fields, args, stmts)))
342 :     end
343 :     | _ => error "argument/parameter mismatch"
344 :     (* end case *)
345 :     end
346 :     | pushArgs _ = error "argument/parameter mismatch"
347 :    
348 :     (* struct return address is an implicit 0th argument*)
349 :     fun pushStructRetAddr (acc) = (case retTy
350 :     of Ty.C_STRUCT fields => let
351 :     val addr = structRet{szb=structSz fields, align=0}
352 :     in
353 :     unsigned{sz=32, e=addr}::acc
354 :     end
355 :     | _ => acc
356 :     (* end case *))
357 :    
358 :     (* call defines callersave registers and uses result registers. *)
359 :     fun mkCall (defs, npop) = let
360 :     val npop = Int32.fromInt npop
361 :     val { save, restore } = saveRestoreDedicated defs
362 :     val callstm =
363 :     T.CALL { funct=name, targets=[], defs=defs, uses=[],
364 :     region=T.Region.memory, pops=npop }
365 :     val callstm =
366 :     case callComment of
367 :     NONE => callstm
368 :     | SOME c => T.ANNOTATION (callstm,
369 :     #create MLRiscAnnotations.COMMENT c)
370 :     (* If return type is floating point then add an annotation RETURN_ARG
371 :     * This is currently a hack. Eventually MLTREE *should* support
372 :     * return arguments for CALLs.
373 :     * --- Allen
374 :     *)
375 :     fun markFpReturn callstm = T.ANNOTATION(callstm, fpReturnValueInST0)
376 :     val callstm =
377 :     if !fast_floating_point then
378 :     (case retTy
379 :     of Ty.C_float => markFpReturn callstm
380 :     | Ty.C_double => markFpReturn callstm
381 :     | Ty.C_long_double => markFpReturn callstm
382 :     | _ => callstm
383 :     )
384 :     else callstm
385 :     in
386 :     save @ callstm :: restore
387 : george 823 end
388 : george 559
389 : jhr 1043 (* size to pop off on return *)
390 :     fun argsSz(Ty.C_STRUCT fields::rest) = let
391 :     val sz = structSz fields
392 :     fun pad16 bytes = (case Word.andb(Word.fromInt sz, 0w1)
393 :     of 0w0 => sz
394 :     | 0w1 => sz+1
395 : mblume 1334 | _ => error ("argSz: " ^ Int.toString sz)
396 : jhr 1043 (* end case *))
397 :     in
398 :     pad16 sz + argsSz(rest)
399 :     end
400 :     | argsSz(ty::rest) =
401 :     (* remember that char and short get promoted... *)
402 :     Int.max(sizeOf(ty),4)+argsSz(rest)
403 :     | argsSz [] = 0
404 : george 600
405 : jhr 1043 val (cRets, cDefs) = resultsAndDefs (retTy)
406 :     val (retRegs, cpyOut) = copyOut(cRets, [], [])
407 :     val n = argsSz paramTys
408 :     val (popseq, implicit_pop) =
409 :     if calleePops orelse n = 0 then ([], n)
410 :     else ([T.MV(32, sp, T.ADD(32, T.REG(32,sp), LI n))], 0)
411 :     val call = mkCall(cDefs, implicit_pop) @ popseq @ cpyOut
412 :     val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))
413 :     in
414 :     {callseq=callSeq, result=retRegs}
415 :     end (* genCall *)
416 : george 559
417 : jhr 1043 end
418 : george 608

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