Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/x86/c-calls/ia32-svid.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 599, Wed Apr 5 18:35:02 2000 UTC revision 600, Wed Apr 5 20:13:47 2000 UTC
# Line 2  Line 2 
2   *   *
3   * COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies   * COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
4   *   *
5   * C function calls for the IA32 using the System V ABI.   * C function calls for the IA32 using the System V ABI
6   *   *
7   * Register conventions:   * Register conventions:
8   *   *
# Line 43  Line 43 
43   *)   *)
44  functor IA32SVID_CCalls  functor IA32SVID_CCalls
45    (structure T : MLTREE    (structure T : MLTREE
46     structure I : X86INSTR     val ix : (T.stm,T.rexp,T.fexp,T.ccexp) X86InstrExt.sext -> T.sext
47     val ix : ('r,'f) X86InstrExt.sext -> T.sext    ) : C_CALL =
      sharing T.LabelExp = I.LabelExp) =  
48  struct  struct
49    structure T  = T    structure T  = T
50    structure Ty = CTypes    structure Ty = CTypes
51    structure C = I.C    structure C = X86Cells
52    structure IX = X86InstrExt    structure IX = X86InstrExt
53    
54    fun error msg = MLRiscErrorMsg.error ("X86CompCCalls.", msg)    fun error msg = MLRiscErrorMsg.error ("X86CompCCalls", msg)
55    
56    (* multiple calling conventions on a single architecture *)    (* multiple calling conventions on a single architecture *)
57    type calling_convention = unit    type calling_convention = unit
58    
59    (* prototype describing C function *)    (* prototype describing C function *)
60    type  c_proto =    type  c_proto =
61      { conv : calling_convention,      { (* conv : calling_convention, *)
62        retTy : CTypes.c_type,        retTy : CTypes.c_type,
63        paramTys : CTypes.c_type list        paramTys : CTypes.c_type list
64       }       }
# Line 71  Line 70 
70      | FARG of T.fexp      | FARG of T.fexp
71      | ARGS of c_arg list      | ARGS of c_arg list
72    
73      val mem = T.Region.memory
74      val stack = T.Region.memory
75    
76      fun intSize(Ty.I_char) = 8
77        | intSize(Ty.I_short) = 16
78        | intSize(Ty.I_int) = 32
79        | intSize(Ty.I_long) = 32
80        | intSize(Ty.I_long_long) = 64
81    
82      fun sizeOf(Ty.C_void) = 32
83        | sizeOf(Ty.C_float) = 32
84        | sizeOf(Ty.C_double) = 64
85        | sizeOf(Ty.C_long_double) = 80     (* no padding required *)
86        | sizeOf(Ty.C_unsigned i) = intSize i
87        | sizeOf(Ty.C_signed i) = intSize i
88        | sizeOf(Ty.C_PTR) = 32
89        | sizeOf(Ty.C_ARRAY _) = 32
90        | sizeOf(Ty.C_STRUCT fields) = structSz fields
91    
92      and structSz fields =
93        List.foldl  (fn (fld, sum) => sizeOf fld + sum) 0 fields
94    
95      val sp = C.esp
96    
97    local    local
98      fun fpr(sz,f) = T.FPR(T.FREG(sz, f))      fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
99      fun gpr(sz,r) = T.GPR(T.REG(sz, r))      fun gpr(sz,r) = T.GPR(T.REG(sz, r))
# Line 78  Line 101 
101      fun eax(sz) = [gpr(sz, C.eax)]      fun eax(sz) = [gpr(sz, C.eax)]
102      val eax32 = eax(32)      val eax32 = eax(32)
103      val pair = gpr(32, C.edx):: eax32      val pair = gpr(32, C.edx):: eax32
   
     fun size(Ty.I_char) = 8  
       | size(Ty.I_short) = 16  
       | size(Ty.I_int) = 32  
       | size(Ty.I_long) = 32  
       | size(Ty.I_long_long) = 64  
104    in    in
105     (* List of result registers;     (* List of result registers;
106      * Multiple returns have most significant register first.      * Multiple returns have most significant register first.
# Line 94  Line 111 
111        | results(Ty.C_long_double) = [fpr(80, st0)]        | results(Ty.C_long_double) = [fpr(80, st0)]
112        | results(Ty.C_unsigned(Ty.I_long_long)) = pair        | results(Ty.C_unsigned(Ty.I_long_long)) = pair
113        | results(Ty.C_signed(Ty.I_long_long)) =  pair        | results(Ty.C_signed(Ty.I_long_long)) =  pair
114        | results(Ty.C_unsigned i) = eax(size i)        | results(Ty.C_unsigned i) = eax(intSize i)
115        | results(Ty.C_signed i) = eax(size i)        | results(Ty.C_signed i) = eax(intSize i)
116        | results(Ty.C_PTR) = eax32        | results(Ty.C_PTR) = eax32
117        | results(Ty.C_ARRAY _) = eax32        | results(Ty.C_ARRAY _) = eax32
118        | results(Ty.C_STRUCT _) = eax32        | results(Ty.C_STRUCT _) = eax32
119    
120        fun fstp (sz, f)  =
121          (case sz
122           of 32 => T.EXT(ix(IX.FSTPS(f)))
123            | 64 => T.EXT(ix(IX.FSTPL(f)))
124            | 80 => T.EXT(ix(IX.FSTPT(f)))
125          (*esac*))
126    
127      (* Copy (result) registers into fresh temporaries *)      (* Copy (result) registers into fresh temporaries *)
128      fun copyOut([], results, stmts) = (results, stmts)      fun copyOut([], results, stmts) = (results, stmts)
129        | copyOut (T.FPR(T.FREG(sz, f))::rest, results, stmts) = let        | copyOut (T.FPR(T.FREG(sz, f))::rest, results, stmts) = let
130            val t = C.newFreg()            val t = C.newFreg()
131          in copyOut(rest, fpr(sz, t)::results, T.FCOPY(sz,[t],[f])::stmts)          in copyOut(rest, fpr(sz, t)::results,
132                       fstp(sz, T.FREG(sz,t))::stmts)
133          end          end
134        | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let        | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let
135            val t = C.newReg()            val t = C.newReg()
# Line 113  Line 138 
138        | copyOut _ = error "copyOut"        | copyOut _ = error "copyOut"
139    end    end
140    
141    fun genCall{name, proto={conv,retTy,paramTys}, structRet, args} = let    fun genCall{name, proto={retTy, paramTys}, structRet, args} = let
142      fun push signed {sz, e} = let      fun push signed {sz, e} = let
143        fun pushl rexp = T.EXT(ix(IX.PUSHL{sz=32, e=rexp}))        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))
144        fun signExtend() = pushl(T.CVTI2I(32, T.SIGN_EXTEND, sz, e))        fun signExtend(e) =
145        fun zeroExtend() = pushl(T.CVTI2I(32, T.ZERO_EXTEND, sz, e))          if sz=32 then e else T.CVTI2I(32, T.SIGN_EXTEND, sz, e)
146      in if signed then signExtend() else zeroExtend()        fun zeroExtend(e) =
147            if sz=32 then e else T.CVTI2I(32, T.ZERO_EXTEND, sz, e)
148        in
149          pushl(if signed then signExtend(e) else zeroExtend(e))
150      end      end
151        val signed = push true
152        val unsigned = push false
153    
154      fun push64 rexp = error "push64"      fun push64 rexp = error "push64"
155    
156      fun fst32 fexp = error "fst32"      (* increment the stack pointer and store floating point result. *)
157      fun fst64 fexp = error "fst64"      fun bumpSp sz = T.MV(32, sp, T.SUB(32, T.REG(32,sp), T.LI sz))
158      fun fst80 fexp = error "fst80"      fun storeAtSp(sz, e) = T.STORE(sz, T.REG(32,sp), e, stack)
159        fun PUSHB(e, stmts) = bumpSp(1)::storeAtSp(8, e)::stmts
160      val signed = push true      fun PUSHW(e, stmts) = bumpSp(2)::storeAtSp(16, e)::stmts
161      val unsigned = push false  
162        fun fst32 fexp = [bumpSp(4), T.FSTORE(32, T.REG(32, sp), fexp, stack)]
163        fun fst64 fexp = [bumpSp(8), T.FSTORE(64, T.REG(32, sp), fexp, stack)]
164        fun fst80 fexp = [bumpSp(10), T.FSTORE(80, T.REG(32, sp), fexp, stack)]
165    
166      fun pushArgs ([], [], stmts) = stmts      fun pushArgs ([], [], stmts) = stmts
167        | pushArgs (param::r1, arg::r2, stmts) = let        | pushArgs (param::r1, arg::r2, stmts) = let
168            fun next stmt = pushArgs (r1, r2, stmt::stmts)            fun next stmt = pushArgs (r1, r2, stmt::stmts)
169              fun nextL stmt = pushArgs (r1, r2, stmt@stmts)
170              (* struct arguments are padded to word boundaries. *)
171              fun pad16(fields, stmts) = let
172                val sz = Int.quot(structSz fields, 8)
173              in
174                case Word.andb(Word.fromInt sz, 0w1)
175                 of 0w0 => stmts
176                  | 0w1 => bumpSp(1)::stmts
177                (*esac*)
178              end
179              fun mkStructArgs(fields, rexp) = let
180                val ptrR = C.newReg()
181                val ptr = T.REG(32, ptrR)
182                fun mkArgs([], i, acc) = (i, rev acc)
183                  | mkArgs(ty::rest, i, acc) = let
184                      fun ea() = T.ADD(32, ptr, T.LI i)
185                      fun fload (bits, bytes) =
186                        mkArgs(rest, i+bytes,
187                               FARG(T.FLOAD(bits, ea(), mem))::acc)
188                      fun load (bits, bytes) =
189                        mkArgs(rest, i+bytes,
190                               ARG(T.LOAD(bits, ea(), mem))::acc)
191                      fun intSz(cint) = let
192                        val sz = intSize cint
193                      in (sz, Int.quot(sz, 8))
194                      end
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                       | Ty.C_PTR => load(32, 8)
204                       | Ty.C_ARRAY _ => load(32, 8)
205                       | 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          in
213            case (param, arg)            case (param, arg)
214            of (Ty.C_float, FARG fexp) => next(fst32 fexp)            of (Ty.C_float, FARG fexp) => nextL(fst32 fexp)
215             | (Ty.C_double, FARG fexp) => next(fst64 fexp)             | (Ty.C_double, FARG fexp) => nextL(fst64 fexp)
216             | (Ty.C_long_double, FARG fexp) => next(fst80 fexp)             | (Ty.C_long_double, FARG fexp) => nextL(fst80 fexp)
217               | (Ty.C_unsigned(Ty.I_char), ARG rexp) =>
218             | (Ty.C_unsigned(Ty.I_char), ARG rexp) => next(unsigned{sz=8, e=rexp})                  next(unsigned{sz=8, e=rexp})
219             | (Ty.C_unsigned(Ty.I_short), ARG rexp) => next(unsigned{sz=16, e=rexp})             | (Ty.C_unsigned(Ty.I_short), ARG rexp) =>
220             | (Ty.C_unsigned(Ty.I_int), ARG rexp) => next(unsigned{sz=32, e=rexp})                  next(unsigned{sz=16, e=rexp})
221             | (Ty.C_unsigned(Ty.I_long), ARG rexp) => next(unsigned{sz=32, e=rexp})             | (Ty.C_unsigned(Ty.I_int), ARG rexp) =>
222             | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) => next(push64(rexp))                  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})             | (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})             | (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})             | (Ty.C_signed(Ty.I_int), ARG rexp) => next(signed{sz=32, e=rexp})
# Line 152  Line 231 
231             | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)             | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)
232             | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})             | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})
233             | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})             | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})
234             | (Ty.C_STRUCT stuff, ARG rexp) => next(unsigned{sz=32, e=rexp})             | (Ty.C_STRUCT fields, ARG rexp) => let
235             | (Ty.C_STRUCT params, ARGS args) =>                  val (ldPtr, args) = mkStructArgs(fields, rexp)
236                  pushArgs(r1, r2, pushArgs(params, args, stmts))                  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             | _ => raise ArgParamMismatch             | _ => raise ArgParamMismatch
281           (* end case *)           (* end case *)
282          end          end
283        | pushArgs _ = raise ArgParamMismatch        | pushArgs _ = raise ArgParamMismatch
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 sz = structSz fields
290               val addr = structRet{szb=Int.quot(sz, 8), align=0}
291             in unsigned{sz=32, e=addr}::acc
292             end
293           | _ => acc
294         (*esac*))
295    
296      (* call defines callersave registers and uses result registers. *)      (* call defines callersave registers and uses result registers. *)
297      fun mkCall ret = let      fun mkCall ret = let
298        val defs = [T.GPR(T.REG(32,C.ecx)), T.GPR(T.REG(32,C.edx))]        val defs = [T.GPR(T.REG(32,C.ecx)), T.GPR(T.REG(32,C.edx))]
# Line 169  Line 302 
302      end      end
303    
304      val c_rets = results(retTy)      val c_rets = results(retTy)
305      val (retRegs, cpys) = copyOut(c_rets, [], [])      val (retRegs, cpyOut) = copyOut(c_rets, [], [])
306      val callSeq = pushArgs(paramTys, args, mkCall(c_rets)::cpys)      val call = mkCall(c_rets)::cpyOut
307        val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))
308    in {callseq=callSeq, result=retRegs}    in {callseq=callSeq, result=retRegs}
309    end    end
310  end  end

Legend:
Removed from v.599  
changed lines
  Added in v.600

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