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 607, Mon Apr 10 16:31:03 2000 UTC revision 608, Mon Apr 10 18:57:09 2000 UTC
# Line 44  Line 44 
44  functor IA32SVID_CCalls  functor IA32SVID_CCalls
45    (structure T : MLTREE    (structure T : MLTREE
46     val ix : (T.stm,T.rexp,T.fexp,T.ccexp) X86InstrExt.sext -> T.sext     val ix : (T.stm,T.rexp,T.fexp,T.ccexp) X86InstrExt.sext -> T.sext
47    ) : C_CALL =    ) : C_CALLS =
48  struct  struct
49    structure T  = T    structure T  = T
50    structure Ty = CTypes    structure Ty = CTypes
# Line 53  Line 53 
53    
54    fun error msg = MLRiscErrorMsg.error ("X86CompCCalls", msg)    fun error msg = MLRiscErrorMsg.error ("X86CompCCalls", msg)
55    
   (* multiple calling conventions on a single architecture *)  
   type calling_convention = unit  
   
   (* prototype describing C function *)  
   type  c_proto =  
     { (* conv : calling_convention, *)  
       retTy : CTypes.c_type,  
       paramTys : CTypes.c_type list  
      }  
   
   exception ArgParamMismatch  
   
56    datatype  c_arg    datatype  c_arg
57      = ARG of T.rexp      = ARG of T.rexp
58      | FARG of T.fexp      | FARG of T.fexp
# Line 73  Line 61 
61    val mem = T.Region.memory    val mem = T.Region.memory
62    val stack = T.Region.memory    val stack = T.Region.memory
63    
64    fun intSize(Ty.I_char) = 8    (* map C integer types to their MLRisc type *)
65      | intSize(Ty.I_short) = 16    fun intTy (Ty.I_char) = 8
66      | intSize(Ty.I_int) = 32      | intTy (Ty.I_short) = 16
67      | intSize(Ty.I_long) = 32      | intTy (Ty.I_int) = 32
68      | intSize(Ty.I_long_long) = 64      | intTy (Ty.I_long) = 32
69        | intTy (Ty.I_long_long) = 64
70    fun sizeOf(Ty.C_void) = 32  
71      | sizeOf(Ty.C_float) = 32    (* size in bytes of C integer type *)
72      | sizeOf(Ty.C_double) = 64    fun intSize (Ty.I_char) = 1
73      | sizeOf(Ty.C_long_double) = 80     (* no padding required *)      | 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      | sizeOf(Ty.C_unsigned i) = intSize i
84      | sizeOf(Ty.C_signed i) = intSize i      | sizeOf(Ty.C_signed i) = intSize i
85      | sizeOf(Ty.C_PTR) = 32      | sizeOf (Ty.C_PTR) = 4
86      | sizeOf(Ty.C_ARRAY _) = 32      | sizeOf (Ty.C_ARRAY _) = 4
87      | sizeOf(Ty.C_STRUCT fields) = structSz fields      | sizeOf(Ty.C_STRUCT fields) = structSz fields
88    
89      (* size in bytes of C struct type *)
90    and structSz fields =    and structSz fields =
91      List.foldl  (fn (fld, sum) => sizeOf fld + sum) 0 fields      List.foldl  (fn (fld, sum) => sizeOf fld + sum) 0 fields
92    
# Line 111  Line 109 
109        | results(Ty.C_long_double) = [fpr(80, st0)]        | results(Ty.C_long_double) = [fpr(80, st0)]
110        | results(Ty.C_unsigned(Ty.I_long_long)) = pair        | results(Ty.C_unsigned(Ty.I_long_long)) = pair
111        | results(Ty.C_signed(Ty.I_long_long)) =  pair        | results(Ty.C_signed(Ty.I_long_long)) =  pair
112        | results(Ty.C_unsigned i) = eax(intSize i)        | results(Ty.C_unsigned i) = eax(intTy i)
113        | results(Ty.C_signed i) = eax(intSize i)        | results(Ty.C_signed i) = eax(intTy i)
114        | results(Ty.C_PTR) = eax32        | results(Ty.C_PTR) = eax32
115        | results(Ty.C_ARRAY _) = eax32        | results(Ty.C_ARRAY _) = eax32
116        | results(Ty.C_STRUCT _) = eax32        | results(Ty.C_STRUCT _) = eax32
# Line 138  Line 136 
136        | copyOut _ = error "copyOut"        | copyOut _ = error "copyOut"
137    end    end
138    
139    fun genCall{name, proto={retTy, paramTys}, structRet, args} = let    fun genCall{name, proto={conv="", retTy, paramTys}, structRet, args} = let
140      fun push signed {sz, e} = let      fun push signed {sz, e} = let
141        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))
142        fun signExtend(e) =        fun signExtend(e) =
# Line 169  Line 167 
167            fun nextL stmt = pushArgs (r1, r2, stmt@stmts)            fun nextL stmt = pushArgs (r1, r2, stmt@stmts)
168            (* struct arguments are padded to word boundaries. *)            (* struct arguments are padded to word boundaries. *)
169            fun pad16(fields, stmts) = let            fun pad16(fields, stmts) = let
170              val sz = Int.quot(structSz fields, 8)              val sz = structSz fields
171            in            in
172              case Word.andb(Word.fromInt sz, 0w1)              case Word.andb(Word.fromInt sz, 0w1)
173               of 0w0 => stmts               of 0w0 => stmts
# Line 188  Line 186 
186                    fun load (bits, bytes) =                    fun load (bits, bytes) =
187                      mkArgs(rest, i+bytes,                      mkArgs(rest, i+bytes,
188                             ARG(T.LOAD(bits, ea(), mem))::acc)                             ARG(T.LOAD(bits, ea(), mem))::acc)
189                    fun intSz(cint) = let                    fun intSz cint = (intTy cint, intSize cint)
                     val sz = intSize cint  
                   in (sz, Int.quot(sz, 8))  
                   end  
190                  in                  in
191                    case ty                    case ty
192                    of Ty.C_void => error "STRUCT: void field"                    of Ty.C_void => error "STRUCT: void field"
# Line 277  Line 272 
272                      end (* pushStruct *)                      end (* pushStruct *)
273               in pushArgs(r1, r2, pad16(fields, pushStruct(fields, args, stmts)))               in pushArgs(r1, r2, pad16(fields, pushStruct(fields, args, stmts)))
274               end               end
275             | _ => raise ArgParamMismatch             | _ => error "argument/parameter mismatch"
276           (* end case *)           (* end case *)
277          end          end
278        | pushArgs _ = raise ArgParamMismatch        | pushArgs _ = error "argument/parameter mismatch"
279    
280      (* struct return address is an implicit 0th argument*)      (* struct return address is an implicit 0th argument*)
281      fun pushStructRetAddr (acc) =      fun pushStructRetAddr (acc) =
282       (case retTy       (case retTy
283        of Ty.C_STRUCT fields => let        of Ty.C_STRUCT fields => let
284             val sz = structSz fields             val addr = structRet{szb=structSz fields, align=0}
            val addr = structRet{szb=Int.quot(sz, 8), align=0}  
285           in unsigned{sz=32, e=addr}::acc           in unsigned{sz=32, e=addr}::acc
286           end           end
287         | _ => acc         | _ => acc
288       (*esac*))       (*esac*))
289    
290      (* call defines callersave registers and uses result registers. *)      (* call defines callersave registers and uses result registers. *)
291      fun mkCall ret = let      fun mkCall uses = let
292        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))]
       val uses = ret  
293      in T.CALL{funct=name, targets=[], defs=defs, uses=uses,      in T.CALL{funct=name, targets=[], defs=defs, uses=uses,
294                cdefs=[], cuses=[], region=T.Region.memory}                cdefs=[], cuses=[], region=T.Region.memory}
295      end      end
296    
297        (* size to pop off on return *)
298        fun argsSz(Ty.C_STRUCT fields::rest) = let
299              val sz = structSz fields
300              fun pad16 bytes =
301                (case Word.andb(Word.fromInt sz, 0w1)
302                 of 0w0 => sz
303                  | 0w1 => sz+1
304                (*esac*))
305            in pad16 sz + argsSz(rest)
306            end
307          | argsSz(ty::rest) = sizeOf(ty)+argsSz(rest)
308          | argsSz [] = 0
309    
310    
311      val c_rets = results(retTy)      val c_rets = results(retTy)
312      val (retRegs, cpyOut) = copyOut(c_rets, [], [])      val (retRegs, cpyOut) = copyOut(c_rets, [], [])
313      val call = mkCall(c_rets)::cpyOut      val popArgs = T.MV(32, sp, T.ADD(32, T.REG(32,sp), T.LI(argsSz paramTys)))
314        val call = mkCall(c_rets)::popArgs::cpyOut
315      val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))      val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))
316    in {callseq=callSeq, result=retRegs}    in {callseq=callSeq, result=retRegs}
317    end    end
318        | genCall {proto={conv, ...}, ...} =
319            error(concat["unknown calling convention \"", String.toString conv, "\""])
320    
321  end  end
322    
323    

Legend:
Removed from v.607  
changed lines
  Added in v.608

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