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/orig-ia32-svid.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 808 - (view) (download)

1 : blume 774 (* ia32-svid.sml
2 :     *
3 :     * COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
4 :     *
5 :     * C function calls for the IA32 using the System V ABI
6 :     *
7 :     * Register conventions:
8 :     *
9 :     * %eax return value (caller save)
10 :     * %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 :     functor IA32SVID_CCalls
45 :     (structure T : MLTREE
46 :     val ix : (T.stm,T.rexp,T.fexp,T.ccexp) X86InstrExt.sext -> T.sext
47 :     ) : C_CALLS =
48 :     struct
49 :     structure T = T
50 :     structure Ty = CTypes
51 :     structure C = X86Cells
52 :     structure IX = X86InstrExt
53 :    
54 :     fun error msg = MLRiscErrorMsg.error ("X86CompCCalls", msg)
55 :    
56 :     datatype c_arg
57 :     = ARG of T.rexp
58 :     | FARG of T.fexp
59 :     | ARGS of c_arg list
60 :    
61 :     val mem = T.Region.memory
62 :     val stack = T.Region.memory
63 :    
64 :     (* map C integer types to their MLRisc type *)
65 :     fun intTy (Ty.I_char) = 8
66 :     | intTy (Ty.I_short) = 16
67 :     | intTy (Ty.I_int) = 32
68 :     | intTy (Ty.I_long) = 32
69 :     | intTy (Ty.I_long_long) = 64
70 :    
71 :     (* size in bytes of C integer type *)
72 :     fun intSize (Ty.I_char) = 1
73 :     | intSize (Ty.I_short) = 2
74 :     | intSize (Ty.I_int) = 4
75 :     | intSize (Ty.I_long) = 4
76 :     | intSize (Ty.I_long_long) = 8
77 :    
78 :     (* size in bytes of C type *)
79 :     fun sizeOf (Ty.C_void) = 4
80 :     | sizeOf (Ty.C_float) = 4
81 :     | sizeOf (Ty.C_double) = 8
82 :     | sizeOf (Ty.C_long_double) = 12 (* no padding required *)
83 :     | sizeOf (Ty.C_unsigned i) = intSize i
84 :     | sizeOf (Ty.C_signed i) = intSize i
85 :     | sizeOf (Ty.C_PTR) = 4
86 :     | sizeOf (Ty.C_ARRAY _) = 4
87 :     | sizeOf (Ty.C_STRUCT fields) = structSz fields
88 :    
89 :     (* size in bytes of C struct type *)
90 :     and structSz fields =
91 :     List.foldl (fn (fld, sum) => sizeOf fld + sum) 0 fields
92 :    
93 :     val sp = C.esp
94 :     fun LI i = T.LI(T.I.fromInt(32, i))
95 :    
96 :     local
97 :     fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
98 :     fun gpr(sz,r) = T.GPR(T.REG(sz, r))
99 :     val st0 = C.ST(0)
100 :     (* note that the caller saves includes the result register (%eax) *)
101 :     val callerSaves = [gpr(32, C.eax), gpr(32, C.ecx), gpr(32, C.edx)]
102 :     val oneRes = [gpr(32, C.eax)]
103 :     val twoRes = [gpr(32, C.edx), gpr(32, C.eax)]
104 :     in
105 :     (* List of registers defined by a C Call; this is the result registers
106 :     * plus the caller save registers.
107 :     * Multiple returns have most significant register first.
108 :     *)
109 :     fun resultsAndDefs (Ty.C_void) = ([], callerSaves)
110 :     | resultsAndDefs (Ty.C_float) =
111 :     ([fpr(32, st0)], fpr(32, st0) :: callerSaves)
112 :     | resultsAndDefs (Ty.C_double) =
113 :     ([fpr(64, st0)], fpr(64, st0) :: callerSaves)
114 :     | resultsAndDefs (Ty.C_long_double) =
115 :     ([fpr(80, st0)], fpr(80, st0) :: callerSaves)
116 :     | resultsAndDefs (Ty.C_unsigned(Ty.I_long_long)) =
117 :     (twoRes, gpr(32, C.edx) :: callerSaves)
118 :     | resultsAndDefs (Ty.C_signed(Ty.I_long_long)) =
119 :     (twoRes, gpr(32, C.edx) :: callerSaves)
120 :     | resultsAndDefs (Ty.C_unsigned i) = (oneRes, callerSaves)
121 :     | resultsAndDefs (Ty.C_signed i) = (oneRes, callerSaves)
122 :     | resultsAndDefs (Ty.C_PTR) = (oneRes, callerSaves)
123 :     | resultsAndDefs (Ty.C_ARRAY _) = (oneRes, callerSaves)
124 :     | resultsAndDefs (Ty.C_STRUCT _) = (oneRes, callerSaves)
125 :    
126 :     fun fstp (sz, f) =
127 :     (case sz
128 :     of 32 => T.EXT(ix(IX.FSTPS(f)))
129 :     | 64 => T.EXT(ix(IX.FSTPL(f)))
130 :     | 80 => T.EXT(ix(IX.FSTPT(f)))
131 :     (*esac*))
132 :    
133 :     (* Copy (result) registers into fresh temporaries *)
134 :     fun copyOut([], results, stmts) = (results, stmts)
135 :     | copyOut (T.FPR(T.FREG(sz, f))::rest, results, stmts) = let
136 :     val t = C.newFreg()
137 :     in copyOut(rest, fpr(sz, t)::results,
138 :     fstp(sz, T.FREG(sz,t))::stmts)
139 :     end
140 :     | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let
141 :     val t = C.newReg()
142 :     in copyOut(rest, gpr(sz, t)::results, T.COPY(sz,[t],[r])::stmts)
143 :     end
144 :     | copyOut _ = error "copyOut"
145 :     end
146 :    
147 :     fun genCall{name, proto={conv="", retTy, paramTys}, structRet, args} = let
148 :     fun push signed {sz, e} = let
149 :     fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))
150 :     fun signExtend(e) = if sz=32 then e else T.SX(32, sz, e)
151 :     fun zeroExtend(e) = if sz=32 then e else T.ZX(32, sz, e)
152 :     in
153 :     pushl(if signed then signExtend(e) else zeroExtend(e))
154 :     end
155 :     val signed = push true
156 :     val unsigned = push false
157 :    
158 :     fun push64 rexp = error "push64"
159 :     (* increment the stack pointer and store floating point result. *)
160 :     fun bumpSp sz = T.MV(32, sp, T.SUB(32, T.REG(32,sp), LI sz))
161 :     fun storeAtSp(sz, e) = T.STORE(sz, T.REG(32,sp), e, stack)
162 :     fun PUSHB(e, stmts) = bumpSp(1)::storeAtSp(8, e)::stmts
163 :     fun PUSHW(e, stmts) = bumpSp(2)::storeAtSp(16, e)::stmts
164 :    
165 :     fun fst32 fexp = [bumpSp(4), T.FSTORE(32, T.REG(32, sp), fexp, stack)]
166 :     fun fst64 fexp = [bumpSp(8), T.FSTORE(64, T.REG(32, sp), fexp, stack)]
167 :     fun fst80 fexp = [bumpSp(10), T.FSTORE(80, T.REG(32, sp), fexp, stack)]
168 :    
169 :     fun pushArgs ([], [], stmts) = stmts
170 :     | pushArgs (param::r1, arg::r2, stmts) = let
171 :     fun next stmt = pushArgs (r1, r2, stmt::stmts)
172 :     fun nextL stmt = pushArgs (r1, r2, stmt@stmts)
173 :     (* struct arguments are padded to word boundaries. *)
174 :     fun pad16(fields, stmts) = let
175 :     val sz = structSz fields
176 :     in
177 :     case Word.andb(Word.fromInt sz, 0w1)
178 :     of 0w0 => stmts
179 :     | 0w1 => bumpSp(1)::stmts
180 :     (*esac*)
181 :     end
182 :     fun mkStructArgs(fields, rexp) = let
183 :     val ptrR = C.newReg()
184 :     val ptr = T.REG(32, ptrR)
185 :     fun mkArgs([], i, acc) = (i, rev acc)
186 :     | mkArgs(ty::rest, i, acc) = let
187 :     fun ea() = T.ADD(32, ptr, LI i)
188 :     fun fload (bits, bytes) =
189 :     mkArgs(rest, i+bytes,
190 :     FARG(T.FLOAD(bits, ea(), mem))::acc)
191 :     fun load (bits, bytes) =
192 :     mkArgs(rest, i+bytes,
193 :     ARG(T.LOAD(bits, ea(), mem))::acc)
194 :     fun intSz cint = (intTy cint, intSize cint)
195 :     in
196 :     case ty
197 :     of Ty.C_void => error "STRUCT: void field"
198 :     | Ty.C_float => fload(32, 4)
199 :     | Ty.C_double => fload(64, 8)
200 :     | Ty.C_long_double => fload(80, 10)
201 :     | Ty.C_unsigned(cint) => load(intSz(cint))
202 :     | Ty.C_signed(cint) => load(intSz(cint))
203 : blume 808 | Ty.C_PTR => load(32, 4)
204 :     | Ty.C_ARRAY _ => load(32, 4)
205 : blume 774 | Ty.C_STRUCT fields => let
206 :     val (i, args) = mkArgs(fields, i, [])
207 :     in mkArgs(rest, i, ARGS args::acc)
208 :     end
209 :     end
210 :     in (T.MV(32, ptrR, rexp), #2 (mkArgs(fields, 0, [])))
211 :     end
212 :     in
213 :     case (param, arg)
214 :     of (Ty.C_float, FARG fexp) => nextL(fst32 fexp)
215 :     | (Ty.C_double, FARG fexp) => nextL(fst64 fexp)
216 :     | (Ty.C_long_double, FARG fexp) => nextL(fst80 fexp)
217 :     | (Ty.C_unsigned(Ty.I_char), ARG rexp) =>
218 :     next(unsigned{sz=8, e=rexp})
219 :     | (Ty.C_unsigned(Ty.I_short), ARG rexp) =>
220 :     next(unsigned{sz=16, e=rexp})
221 :     | (Ty.C_unsigned(Ty.I_int), ARG rexp) =>
222 :     next(unsigned{sz=32, e=rexp})
223 :     | (Ty.C_unsigned(Ty.I_long), ARG rexp) =>
224 :     next(unsigned{sz=32, e=rexp})
225 :     | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) =>
226 :     next(push64(rexp))
227 :     | (Ty.C_signed(Ty.I_char), ARG rexp) => next(signed{sz=8, e=rexp})
228 :     | (Ty.C_signed(Ty.I_short), ARG rexp) => next(signed{sz=16, e=rexp})
229 :     | (Ty.C_signed(Ty.I_int), ARG rexp) => next(signed{sz=32, e=rexp})
230 :     | (Ty.C_signed(Ty.I_long), ARG rexp) => next(signed{sz=32, e=rexp})
231 :     | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)
232 :     | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})
233 :     | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})
234 :     | (Ty.C_STRUCT fields, ARG rexp) => let
235 :     val (ldPtr, args) = mkStructArgs(fields, rexp)
236 :     val stmts = pushArgs([param], [ARGS(args)], stmts)
237 :     in pushArgs(r1, r2, ldPtr::stmts)
238 :     end
239 :     | (Ty.C_STRUCT fields, ARGS args) => let
240 :     fun pushStruct([], [], stmts) = stmts
241 :     | pushStruct(ty::tys, arg::args, stmts) = let
242 :     fun cont(stmts) = pushStruct(tys, args, stmts)
243 :     fun pushf(sz, fexp) =
244 :     (case sz
245 :     of 32 => fst32(fexp)
246 :     | 64 => fst64(fexp)
247 :     | 80 => fst80(fexp)
248 :     (*esac*)) @ stmts
249 :     fun pushb (rexp) = cont(PUSHB(rexp, stmts))
250 :     fun pushw (rexp) = cont(PUSHW(rexp, stmts))
251 :     fun pushl (rexp) = cont(T.EXT(ix(IX.PUSHL(rexp)))::stmts)
252 :     fun pushCint(cint, rexp) =
253 :     (case cint
254 :     of Ty.I_char => pushb(rexp)
255 :     | Ty.I_short => pushw(rexp)
256 :     | Ty.I_int => pushl(rexp)
257 :     | Ty.I_long => pushl(rexp)
258 :     | Ty.I_long_long => error "STRUCT: long_long"
259 :     (*esac*))
260 :     in
261 :     case (ty, arg)
262 :     of (Ty.C_void, _) => error "STRUCT: void field"
263 :     | (Ty.C_float, FARG fexp) => cont(pushf(32,fexp))
264 :     | (Ty.C_double, FARG fexp) => cont(pushf(64, fexp))
265 :     | (Ty.C_long_double, FARG fexp) => cont(pushf(80, fexp))
266 :     | (Ty.C_unsigned(cint), ARG rexp) => pushCint(cint, rexp)
267 :     | (Ty.C_signed(cint), ARG rexp) => pushCint(cint, rexp)
268 :     | (Ty.C_PTR, ARG rexp) => pushl(rexp)
269 :     | (Ty.C_ARRAY _, ARG rexp) => pushl(rexp)
270 :     | (Ty.C_STRUCT fields, ARG rexp) => let
271 :     val (ldPtr, args) = mkStructArgs(fields, rexp)
272 :     in cont(ldPtr::pushStruct(fields, args, stmts))
273 :     end
274 :     | (Ty.C_STRUCT fields, ARGS rexps) => let
275 :     in cont(pushStruct(fields, rexps, stmts))
276 :     end
277 :     end (* pushStruct *)
278 :     in pushArgs(r1, r2, pad16(fields, pushStruct(fields, args, stmts)))
279 :     end
280 :     | _ => error "argument/parameter mismatch"
281 :     (* end case *)
282 :     end
283 :     | pushArgs _ = error "argument/parameter mismatch"
284 :    
285 :     (* struct return address is an implicit 0th argument*)
286 :     fun pushStructRetAddr (acc) =
287 :     (case retTy
288 :     of Ty.C_STRUCT fields => let
289 :     val addr = structRet{szb=structSz fields, align=0}
290 :     in unsigned{sz=32, e=addr}::acc
291 :     end
292 :     | _ => acc
293 :     (*esac*))
294 :    
295 :     (* call defines callersave registers and uses result registers. *)
296 :     fun mkCall defs = T.CALL{
297 :     funct=name, targets=[], defs=defs, uses=[],
298 :     region=T.Region.memory
299 :     }
300 :    
301 :     (* size to pop off on return *)
302 :     fun argsSz(Ty.C_STRUCT fields::rest) = let
303 :     val sz = structSz fields
304 :     fun pad16 bytes =
305 :     (case Word.andb(Word.fromInt sz, 0w1)
306 :     of 0w0 => sz
307 :     | 0w1 => sz+1
308 :     (*esac*))
309 :     in pad16 sz + argsSz(rest)
310 :     end
311 :     | argsSz(ty::rest) = sizeOf(ty)+argsSz(rest)
312 :     | argsSz [] = 0
313 :    
314 :    
315 :     val (cRets, cDefs) = resultsAndDefs (retTy)
316 :     val (retRegs, cpyOut) = copyOut(cRets, [], [])
317 :     val call = mkCall(cDefs) :: (case argsSz paramTys
318 :     of 0 => cpyOut
319 :     | n => T.MV(32, sp, T.ADD(32, T.REG(32,sp), LI n)) :: cpyOut
320 :     (* end case *))
321 :     val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))
322 :     in {callseq=callSeq, result=retRegs}
323 :     end
324 :     | genCall {proto={conv, ...}, ...} =
325 :     error(concat["unknown calling convention \"", String.toString conv, "\""])
326 :    
327 :     end

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