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 559 - (view) (download)

1 : george 559 (* 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
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 :     structure I : X86INSTR
47 :     val ix : ('r,'f) X86InstrExt.sext -> T.sext
48 :     sharing T.LabelExp = I.LabelExp) =
49 :     struct
50 :     structure T = T
51 :     structure Ty = CTypes
52 :     structure C = I.C
53 :     structure IX = X86InstrExt
54 :    
55 :     fun error msg = MLRiscErrorMsg.error ("X86CompCCalls.", msg)
56 :    
57 :     (* multiple calling conventions on a single architecture *)
58 :     type calling_convention = unit
59 :    
60 :     (* prototype describing C function *)
61 :     type c_proto =
62 :     { conv : calling_convention,
63 :     retTy : CTypes.c_type,
64 :     paramTys : CTypes.c_type list
65 :     }
66 :    
67 :     exception ArgParamMismatch
68 :    
69 :     datatype c_arg
70 :     = ARG of T.rexp
71 :     | FARG of T.fexp
72 :     | ARGS of c_arg list
73 :    
74 :     local
75 :     fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
76 :     fun gpr(sz,r) = T.GPR(T.REG(sz, r))
77 :     val st0 = C.ST(0)
78 :     fun eax(sz) = [gpr(sz, C.eax)]
79 :     val eax32 = eax(32)
80 :     val pair = gpr(32, C.edx):: eax32
81 :    
82 :     fun size(Ty.I_char) = 8
83 :     | size(Ty.I_short) = 16
84 :     | size(Ty.I_int) = 32
85 :     | size(Ty.I_long) = 32
86 :     | size(Ty.I_long_long) = 64
87 :     in
88 :     (* List of result registers;
89 :     * Multiple returns have most significant register first.
90 :     *)
91 :     fun results(Ty.C_void) = []
92 :     | results(Ty.C_float) = [fpr(32, st0)]
93 :     | results(Ty.C_double) = [fpr(64, st0)]
94 :     | results(Ty.C_long_double) = [fpr(80, st0)]
95 :     | results(Ty.C_unsigned(Ty.I_long_long)) = pair
96 :     | results(Ty.C_signed(Ty.I_long_long)) = pair
97 :     | results(Ty.C_unsigned i) = eax(size i)
98 :     | results(Ty.C_signed i) = eax(size i)
99 :     | results(Ty.C_PTR) = eax32
100 :     | results(Ty.C_ARRAY _) = eax32
101 :     | results(Ty.C_STRUCT _) = eax32
102 :    
103 :     (* Copy (result) registers into fresh temporaries *)
104 :     fun copyOut([], results, stmts) = (results, stmts)
105 :     | copyOut (T.FPR(T.FREG(sz, f))::rest, results, stmts) = let
106 :     val t = C.newFreg()
107 :     in copyOut(rest, fpr(sz, t)::results, T.FCOPY(sz,[t],[f])::stmts)
108 :     end
109 :     | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let
110 :     val t = C.newReg()
111 :     in copyOut(rest, gpr(sz, t)::results, T.COPY(sz,[t],[r])::stmts)
112 :     end
113 :     | copyOut _ = error "copyOut"
114 :     end
115 :    
116 :     fun genCall{name, proto={conv,retTy,paramTys}, structRet, args} = let
117 :     fun push signed {sz, e} = let
118 :     fun pushl rexp = T.EXT(ix(IX.PUSHL{sz=32, e=rexp}))
119 :     fun signExtend() = pushl(T.CVTI2I(32, T.SIGN_EXTEND, sz, e))
120 :     fun zeroExtend() = pushl(T.CVTI2I(32, T.ZERO_EXTEND, sz, e))
121 :     in if signed then signExtend() else zeroExtend()
122 :     end
123 :    
124 :     fun push64 rexp = error "push64"
125 :    
126 :     fun fst32 fexp = error "fst32"
127 :     fun fst64 fexp = error "fst64"
128 :     fun fst80 fexp = error "fst80"
129 :    
130 :     val signed = push true
131 :     val unsigned = push false
132 :    
133 :     fun pushArgs ([], [], stmts) = stmts
134 :     | pushArgs (param::r1, arg::r2, stmts) = let
135 :     fun next stmt = pushArgs (r1, r2, stmt::stmts)
136 :     in
137 :     case (param, arg)
138 :     of (Ty.C_float, FARG fexp) => next(fst32 fexp)
139 :     | (Ty.C_double, FARG fexp) => next(fst64 fexp)
140 :     | (Ty.C_long_double, FARG fexp) => next(fst80 fexp)
141 :    
142 :     | (Ty.C_unsigned(Ty.I_char), ARG rexp) => next(unsigned{sz=8, e=rexp})
143 :     | (Ty.C_unsigned(Ty.I_short), ARG rexp) => next(unsigned{sz=16, e=rexp})
144 :     | (Ty.C_unsigned(Ty.I_int), ARG rexp) => next(unsigned{sz=32, e=rexp})
145 :     | (Ty.C_unsigned(Ty.I_long), ARG rexp) => next(unsigned{sz=32, e=rexp})
146 :     | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) => next(push64(rexp))
147 :    
148 :     | (Ty.C_signed(Ty.I_char), ARG rexp) => next(signed{sz=8, e=rexp})
149 :     | (Ty.C_signed(Ty.I_short), ARG rexp) => next(signed{sz=16, e=rexp})
150 :     | (Ty.C_signed(Ty.I_int), ARG rexp) => next(signed{sz=32, e=rexp})
151 :     | (Ty.C_signed(Ty.I_long), ARG rexp) => next(signed{sz=32, e=rexp})
152 :     | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)
153 :     | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})
154 :     | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})
155 :     | (Ty.C_STRUCT stuff, ARG rexp) => next(unsigned{sz=32, e=rexp})
156 :     | (Ty.C_STRUCT params, ARGS args) =>
157 :     pushArgs(r1, r2, pushArgs(params, args, stmts))
158 :     | _ => raise ArgParamMismatch
159 :     (* end case *)
160 :     end
161 :     | pushArgs _ = raise ArgParamMismatch
162 :    
163 :     (* call defines callersave registers and uses result registers. *)
164 :     fun mkCall ret = let
165 :     val defs = [T.GPR(T.REG(32,C.ecx)), T.GPR(T.REG(32,C.edx))]
166 :     val uses = ret
167 :     in T.CALL(name, [], defs, uses, [], [], T.Region.memory)
168 :     end
169 :    
170 :     val c_rets = results(retTy)
171 :     val (retRegs, cpys) = copyOut(c_rets, [], [])
172 :     val callSeq = pushArgs(paramTys, args, mkCall(c_rets)::cpys)
173 :     in {callseq=callSeq, result=retRegs}
174 :     end
175 :     end
176 :    
177 :    

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