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/branches/blume-private-devel/src/MLRISC/x86/c-calls/ia32-svid.sml
ViewVC logotype

Annotation of /sml/branches/blume-private-devel/src/MLRISC/x86/c-calls/ia32-svid.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1596 - (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 : mblume 1592 fun error msg = MLRiscErrorMsg.error ("IA32SVID_CCalls", 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 : mblume 1592 (* MLRISC types *)
70 :     val wordTy = 32
71 :     val fltTy = 32
72 :     val dblTy = 64
73 :     val xdblTy = 80
74 :    
75 :     (* shorts and chars are promoted to 32-bits *)
76 :     val naturalIntSz = wordTy
77 :    
78 : jhr 1043 val paramAreaOffset = 0 (* stack offset to param area *)
79 :    
80 : leunga 972 (* This annotation is used to indicate that a call returns a fp value
81 :     * in %st(0)
82 :     *)
83 : jhr 1043 val fpReturnValueInST0 = #create MLRiscAnnotations.RETURN_ARG C.ST0
84 : leunga 972
85 : mblume 1592 val sp = C.esp
86 :     val spR = T.REG(wordTy, sp)
87 : george 600
88 : mblume 1592 fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
89 :     fun gpr(sz,r) = T.GPR(T.REG(sz, r))
90 :     val eax = C.eax
91 :     val st0 = C.ST(0)
92 : george 600
93 : mblume 1592 (* note that the caller saves includes the result register (%eax) *)
94 :     val callerSaves = [gpr(wordTy, eax), gpr(wordTy, C.ecx), gpr(wordTy, C.edx)]
95 : george 600
96 : mblume 1592 (* C callee-save registers *)
97 :     val calleeSaveRegs = [C.ebx, C.esi, C.edi] (* C callee-save registers *)
98 :     val calleeSaveFRegs = [] (* C callee-save floating-point registers *)
99 : george 608
100 : mblume 1592 (* align the address to the given alignment, which must be a power of 2 *)
101 :     fun alignAddr (addr, align) = let
102 :     val mask = Word.fromInt(align-1)
103 :     in
104 :     Word.toIntX(Word.andb(Word.fromInt addr + mask, Word.notb mask))
105 :     end
106 : george 600
107 : mblume 1592 fun align4 addr = Word.toIntX(Word.andb(Word.fromInt addr + 0w3, Word.notb 0w3))
108 :    
109 :     (* size and natural alignment for integer types. *)
110 :     fun sizeOfInt Ty.I_char = {ty = 8, sz = 1, align = 1}
111 :     | sizeOfInt Ty.I_short = {ty = 16, sz = 2, align = 2}
112 :     | sizeOfInt Ty.I_int = {ty = 32, sz = 4, align = 4}
113 :     | sizeOfInt Ty.I_long = {ty = 32, sz = 4, align = 4}
114 :     | sizeOfInt Ty.I_long_long = {ty = 64, sz = 8, align = 4}
115 :    
116 :     (* sizes of other C types *)
117 :     val sizeOfPtr = {ty = 32, sz = 4, align = 4}
118 :    
119 :     (* compute the size and alignment information for a struct; tys is the list
120 :     * of member types.
121 :     * The total size is padded to agree with the struct's alignment.
122 : jhr 1043 *)
123 : mblume 1592 fun sizeOfStruct tys = let
124 :     fun ssz ([], maxAlign, offset) =
125 :     {sz = alignAddr(offset, maxAlign), align = maxAlign}
126 :     | ssz (ty::tys, maxAlign, offset) = let
127 :     val {sz, align} = sizeOfTy ty
128 :     val offset = alignAddr(offset, align)
129 :     in
130 :     ssz (tys, Int.max(maxAlign, align), offset+sz)
131 :     end
132 :     in
133 :     ssz (tys, 1, 0)
134 :     end
135 : george 600
136 : mblume 1592 (* the size alignment of a union type is the maximum of the sizes and alignments of the
137 :     * members. The final size is padded to agree with the alignment.
138 :     *)
139 :     and sizeOfUnion tys = let
140 :     fun usz ([], maxAlign, maxSz) =
141 :     {sz = alignAddr(maxSz, maxAlign), align = maxAlign}
142 :     | usz (ty::tys, maxAlign, maxSz) = let
143 :     val {sz, align} = sizeOfTy ty
144 :     in
145 :     usz (tys, Int.max(maxAlign, align), Int.max(sz, maxSz))
146 :     end
147 :     in
148 :     usz (tys, 1, 0)
149 :     end
150 : mblume 1535
151 : mblume 1592 and sizeOfTy Ty.C_void = error "unexpected void argument type"
152 :     | sizeOfTy Ty.C_float = {sz = 4, align = 4}
153 :     | sizeOfTy Ty.C_double = {sz = 8, align = 4}
154 :     | sizeOfTy Ty.C_long_double = {sz = 12, align = 4}
155 :     | sizeOfTy (Ty.C_unsigned isz) = let
156 :     val {sz, align, ...} = sizeOfInt isz
157 :     in
158 :     {sz = sz, align = align}
159 :     end
160 :     | sizeOfTy (Ty.C_signed isz) = let
161 :     val {sz, align, ...} = sizeOfInt isz
162 :     in
163 :     {sz = sz, align = align}
164 :     end
165 :     | sizeOfTy Ty.C_PTR = {sz = 4, align = 4}
166 :     | sizeOfTy (Ty.C_ARRAY(ty, n)) = let
167 :     val {sz, align} = sizeOfTy ty
168 :     in
169 :     {sz = n*sz, align = align}
170 :     end
171 :     | sizeOfTy (Ty.C_STRUCT tys) = sizeOfStruct tys
172 :     | sizeOfTy (Ty.C_UNION tys) = sizeOfUnion tys
173 :    
174 : mblume 1535 (* the location of arguments/parameters; offsets are given with respect to the
175 :     * low end of the parameter area (see paramAreaOffset above).
176 :     *)
177 :     datatype arg_location
178 :     = Reg of T.ty * T.reg * T.I.machine_int option
179 :     (* integer/pointer argument in register *)
180 :     | FReg of T.fty * T.reg * T.I.machine_int option
181 :     (* floating-point argument in register *)
182 :     | Stk of T.ty * T.I.machine_int (* integer/pointer argument in parameter area *)
183 :     | FStk of T.fty * T.I.machine_int (* floating-point argument in parameter area *)
184 :     | Args of arg_location list
185 :    
186 :     fun layout {conv, retTy, paramTys} = let
187 : mblume 1592 (* get the location of the result (resLoc) and the offset of the first
188 :     * parameter/argument. If the result is a struct or union, then we also
189 :     * compute the size and alignment of the result type (structRetLoc).
190 :     *)
191 :     val (resLoc, structRetLoc, argOffset) = (case retTy
192 :     of Ty.C_void => (NONE, NONE, 0)
193 :     | Ty.C_float => (SOME(FReg(fltTy, st0, NONE)), NONE, 0)
194 :     | Ty.C_double => (SOME(FReg(dblTy, st0, NONE)), NONE, 0)
195 :     | Ty.C_long_double => (SOME(FReg(xdblTy, st0, NONE)), NONE, 0)
196 : mblume 1596 | Ty.C_unsigned Ty.I_long_long => raise Fail "register pair"
197 :     | Ty.C_signed Ty.I_long_long => raise Fail "register pair"
198 :     | Ty.C_unsigned _ =>
199 :     (* Should we distinguish between different word
200 :     * sized here? -- Matthias *)
201 :     (SOME(Reg(wordTy,eax,NONE)),NONE,0)
202 :     | Ty.C_signed _ =>
203 :     (* Should we distinguish between different int
204 :     * sized here? -- Matthias *)
205 :     (SOME(Reg(wordTy,eax,NONE)),NONE,0)
206 : mblume 1592 | Ty.C_PTR => (SOME(Reg(wordTy, eax, NONE)), NONE, 0)
207 :     | Ty.C_ARRAY _ => error "array return type"
208 :     | Ty.C_STRUCT tys => let
209 :     val {sz, align} = sizeOfStruct tys
210 :     in
211 :     (SOME(Reg(wordTy, eax, NONE)), SOME{szb=sz, align=align}, 4)
212 :     end
213 :     | Ty.C_UNION tys => let
214 :     val {sz, align} = sizeOfUnion tys
215 :     in
216 :     (SOME(Reg(wordTy, eax, NONE)), SOME{szb=sz, align=align}, 4)
217 :     end
218 :     (* end case *))
219 :     fun assign ([], offset, locs) = (List.rev locs, align4 offset)
220 :     | assign (paramTy::params, offset, locs) = let
221 :     fun next {ty, align, sz} = let
222 :     val offset = alignAddr (offset, align)
223 :     in
224 :     assign (params, offset+sz, Stk(ty, IntInf.fromInt offset)::locs)
225 :     end
226 :     fun nextFlt (ty, szb) = let
227 :     val offset = alignAddr (offset, 4)
228 :     in
229 :     assign (params, offset+szb, FStk(ty, IntInf.fromInt offset)::locs)
230 :     end
231 :     fun assignMem {sz, align} = let
232 :     fun f (nb, offset, locs') =
233 :     if (nb >= 4)
234 :     then f(nb-4, offset+4, Stk(wordTy, IntInf.fromInt offset)::locs')
235 :     else if (nb >= 2)
236 :     then f(nb-2, offset+2, Stk(16, IntInf.fromInt offset)::locs')
237 :     else if (nb = 1)
238 :     then f(nb, offset+1, Stk(8, IntInf.fromInt offset)::locs')
239 :     else assign(params, align4 offset, Args(List.rev locs')::locs)
240 :     in
241 :     f (sz, offset, [])
242 :     end
243 :     in
244 :     case paramTy
245 :     of Ty.C_void => error "void argument type"
246 :     | Ty.C_float => nextFlt (fltTy, 4)
247 :     | Ty.C_double => nextFlt (dblTy, 8)
248 :     | Ty.C_long_double => nextFlt (xdblTy, 12)
249 :     | Ty.C_unsigned iTy => next (sizeOfInt iTy)
250 :     | Ty.C_signed iTy => next (sizeOfInt iTy)
251 :     | Ty.C_PTR => next sizeOfPtr
252 :     | Ty.C_ARRAY _ => next sizeOfPtr
253 :     | Ty.C_STRUCT tys => assignMem(sizeOfStruct tys)
254 :     | Ty.C_UNION tys => assignMem(sizeOfUnion tys)
255 :     (* end case *)
256 :     end
257 :     val (argLocs, argSz) = assign (paramTys, argOffset, [])
258 :     in {
259 :     argLocs = argLocs, argMem = {szb = argSz, align = 4},
260 :     resLoc = resLoc, structRetLoc = structRetLoc
261 :     } end
262 : mblume 1535
263 : mblume 1592 (* List of registers defined by a C Call with the given return type; this list
264 :     * is the result registers plus the caller-save registers.
265 :     *)
266 :     fun definedRegs (Ty.C_float) = fpr(fltTy, st0) :: callerSaves
267 :     | definedRegs (Ty.C_double) = fpr(dblTy, st0) :: callerSaves
268 :     | definedRegs (Ty.C_long_double) = fpr(xdblTy, st0) :: callerSaves
269 :     | definedRegs (Ty.C_unsigned(Ty.I_long_long)) = gpr(wordTy, C.edx) :: callerSaves
270 :     | definedRegs (Ty.C_signed(Ty.I_long_long)) = gpr(wordTy, C.edx) :: callerSaves
271 :     | definedRegs _ = callerSaves
272 : mblume 1535
273 : jhr 1043 fun fstp (32, f) = T.EXT(ix(IX.FSTPS(f)))
274 :     | fstp (64, f) = T.EXT(ix(IX.FSTPL(f)))
275 :     | fstp (80, f) = T.EXT(ix(IX.FSTPT(f)))
276 : mblume 1334 | fstp (sz, f) = error ("fstp(" ^ Int.toString sz ^ ",_)")
277 : george 559
278 : mblume 1592 fun genCall {
279 :     name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args
280 :     } = let
281 :     val {argLocs, argMem, resLoc, structRetLoc} = layout proto
282 :     (* instruction to allocate space for arguments *)
283 :     val argAlloc = if ((#szb argMem > 0) andalso paramAlloc argMem)
284 :     then [T.MV(wordTy, sp, T.SUB(wordTy, spR, T.LI(IntInf.fromInt(#szb argMem))))]
285 :     else []
286 :     (* for functions that return a struct/union, pass the location
287 :     * as an implicit first argument.
288 :     *)
289 :     val (args, argLocs) = (case structRetLoc
290 :     of SOME pos => (ARG(structRet pos)::args, Stk(wordTy, 0)::argLocs)
291 :     | NONE => (args, argLocs)
292 :     (* end case *))
293 :     (* generate instructions to copy arguments into argument area
294 :     * using %esp to address the argument area.
295 :     *)
296 :     val copyArgs = let
297 :     fun offSP 0 = spR
298 :     | offSP offset = T.ADD(wordTy, spR, T.LI offset)
299 :     fun f ([], [], stms) = List.rev stms
300 :     | f (arg::args, loc::locs, stms) = let
301 :     val stms = (case (arg, loc)
302 :     of (ARG(rexp as T.REG _), Stk(mty, offset)) =>
303 :     T.STORE(mty, offSP offset, rexp, stack)
304 :     :: stms
305 :     | (ARG rexp, Stk(mty, offset)) => let
306 :     val tmp = C.newReg()
307 :     in
308 :     T.STORE(wordTy, offSP offset, T.REG(wordTy, tmp), stack)
309 :     :: T.MV(wordTy, tmp, rexp)
310 :     :: stms
311 :     end
312 :     | (ARG rexp, Args memLocs) => let
313 :     val (loadAddr, addrR) = (case rexp
314 :     of T.REG _ => ([], rexp)
315 :     | _ => let
316 :     val r = C.newReg()
317 :     in
318 :     ([T.MV(wordTy, r, rexp)], T.REG(wordTy, r))
319 :     end
320 :     (* end case *))
321 :     fun addr 0 = addrR
322 :     | addr offset = T.ADD(wordTy, addrR, T.LI offset)
323 :     fun copy ([], stms) = stms
324 :     | copy (Stk(ty, offset)::locs, stms) = let
325 :     val tmp = C.newReg()
326 :     in
327 :     T.STORE(ty, offSP offset, T.REG(ty, tmp), stack)
328 :     :: T.MV(ty, tmp, addr offset)
329 :     :: stms
330 :     end
331 :     | copy _ = error "bogus memory location"
332 :     in
333 :     copy (memLocs, loadAddr @ stms)
334 :     end
335 :     | (FARG(fexp as T.FREG _), FStk(ty, offset)) =>
336 :     T.FSTORE(ty, offSP offset, fexp, stack) :: stms
337 :     | (FARG fexp, FStk(ty, offset)) => let
338 :     val tmp = C.newFreg()
339 :     in
340 :     T.FSTORE(ty, offSP offset, T.FREG(ty, tmp), stack)
341 :     :: T.FMV(ty, tmp, fexp)
342 :     :: stms
343 :     end
344 :     | (ARGS _, _) => raise Fail "ARGS obsolete"
345 :     | _ => error "impossible location"
346 :     (* end case *))
347 :     in
348 :     f (args, locs, stms)
349 :     end
350 :     | f _ = error "argument arity error"
351 :     in
352 :     f (args, argLocs, [])
353 :     end
354 :     (* the SVID specifies that the caller pops arguments, but a the callee
355 :     * pops the arguments in a stdcall on Windows. I'm not sure what other
356 :     * differences there might be between the SVID and Windows ABIs. (JHR)
357 :     *)
358 :     val calleePops = (case #conv proto
359 : jhr 1043 of (""|"ccall") => false
360 :     | "stdcall" => true
361 : mblume 1592 | conv => error (concat [
362 : jhr 1043 "unknown calling convention \"", String.toString conv, "\""
363 :     ])
364 :     (* end case *))
365 : mblume 1592 val defs = definedRegs(#retTy proto)
366 :     val { save, restore } = saveRestoreDedicated defs
367 :     val callStm = T.CALL{
368 :     funct=name, targets=[], defs=defs, uses=[],
369 :     region = T.Region.memory,
370 :     pops = if calleePops then Int32.fromInt(#szb argMem) else 0
371 :     }
372 :     val callStm = (case callComment
373 :     of NONE => callStm
374 :     | SOME c => T.ANNOTATION (callStm, #create MLRiscAnnotations.COMMENT c)
375 :     (* end case *))
376 :     (* If return type is floating point then add an annotation RETURN_ARG
377 :     * This is currently a hack. Eventually MLTREE *should* support
378 :     * return arguments for CALLs.
379 :     * --- Allen
380 :     *)
381 :     val callStm = if !fast_floating_point
382 :     andalso ((#retTy proto = Ty.C_float)
383 :     orelse (#retTy proto = Ty.C_double)
384 :     orelse (#retTy proto = Ty.C_long_double))
385 :     then T.ANNOTATION(callStm, fpReturnValueInST0)
386 :     else callStm
387 :     (* code to pop the arguments from the stack *)
388 :     val popArgs = if calleePops
389 :     then []
390 :     else [T.MV(wordTy, sp, T.ADD(wordTy, spR, T.LI(IntInf.fromInt(#szb argMem))))]
391 :     (* code to copy the result into fresh pseudo registers *)
392 :     val (resultRegs, copyResult) = (case resLoc
393 :     of NONE => ([], [])
394 :     | SOME(Reg(ty, r, _)) => let
395 :     val resReg = C.newReg()
396 : jhr 1043 in
397 : mblume 1592 ([T.GPR(T.REG(ty, resReg))], [T.COPY(ty, [resReg], [r])])
398 : jhr 1043 end
399 : mblume 1592 | SOME(FReg(ty, r, _)) => let
400 :     val resReg = C.newFreg()
401 :     val res = [T.FPR(T.FREG(ty, r))]
402 : jhr 1043 in
403 : mblume 1592 (* If we are using fast floating point mode then do NOT
404 :     * generate FSTP.
405 :     * --- Allen
406 :     *)
407 :     if !fast_floating_point
408 :     then (res, [T.FCOPY(ty, [resReg], [r])])
409 :     else (res, [fstp(ty, T.FREG(ty, resReg))])
410 : jhr 1043 end
411 : mblume 1592 | _ => error "bogus result location"
412 : jhr 1043 (* end case *))
413 : mblume 1592 (* assemble the call sequence *)
414 :     val callSeq = copyArgs @ save @ [callStm] @ restore @ popArgs @ copyResult
415 : jhr 1043 in
416 : mblume 1592 {callseq=callSeq, result=resultRegs}
417 : george 823 end
418 : george 559
419 : jhr 1043 end
420 : george 608

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