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 1042, Mon Jan 28 17:26:42 2002 UTC revision 1043, Mon Jan 28 21:26:03 2002 UTC
# Line 41  Line 41 
41   * Questions:   * Questions:
42   *    - what about stack frame alignment?   *    - what about stack frame alignment?
43   *)   *)
44  functor IA32SVID_CCalls  
45    (structure T : MLTREE  functor IA32SVID_CCalls (
46        structure T : MLTREE
47     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
48         (* Should we use allocate register on the floating point stack?    (* Note that the fast_loating_point flag must match the one passed
49          * Note that this flag must match the one passed to the code generator     * to the code generator module.
         * module.  
50          *)          *)
51     val fast_floating_point : bool ref     val fast_floating_point : bool ref
52    ) : C_CALLS =    ) : C_CALLS = struct
53  struct  
54    structure T  = T    structure T  = T
55    structure Ty = CTypes    structure Ty = CTypes
56    structure C = X86Cells    structure C = X86Cells
# Line 66  Line 66 
66    val mem = T.Region.memory    val mem = T.Region.memory
67    val stack = T.Region.memory    val stack = T.Region.memory
68    
69        val paramAreaOffset = 0 (* stack offset to param area *)
70    
71    (* This annotation is used to indicate that a call returns a fp value    (* This annotation is used to indicate that a call returns a fp value
72     * in %st(0)     * in %st(0)
73     *)     *)
# Line 133  Line 135 
135        | resultsAndDefs (Ty.C_ARRAY _) = (oneRes, callerSaves)        | resultsAndDefs (Ty.C_ARRAY _) = (oneRes, callerSaves)
136        | resultsAndDefs (Ty.C_STRUCT _) = (oneRes, callerSaves)        | resultsAndDefs (Ty.C_STRUCT _) = (oneRes, callerSaves)
137    
138      fun fstp (sz, f)  =      fun fstp (32, f) = T.EXT(ix(IX.FSTPS(f)))
139        (case sz        | fstp (64, f) = T.EXT(ix(IX.FSTPL(f)))
140         of 32 => T.EXT(ix(IX.FSTPS(f)))        | fstp (80, f) = T.EXT(ix(IX.FSTPT(f)))
         | 64 => T.EXT(ix(IX.FSTPL(f)))  
         | 80 => T.EXT(ix(IX.FSTPT(f)))  
       (*esac*))  
141    
142      (* Copy (result) registers into fresh temporaries *)      (* Copy (result) registers into fresh temporaries *)
143      fun copyOut([], results, stmts) = (results, stmts)      fun copyOut([], results, stmts) = (results, stmts)
# Line 151  Line 150 
150            val stmt = if !fast_floating_point            val stmt = if !fast_floating_point
151                       then T.FCOPY(sz, [t], [f])                       then T.FCOPY(sz, [t], [f])
152                       else fstp(sz, T.FREG(sz, t))                       else fstp(sz, T.FREG(sz, t))
153          in copyOut(rest, fpr(sz, t)::results,            in
154                     stmt::stmts)              copyOut (rest, fpr(sz, t)::results, stmt::stmts)
155          end          end
156        | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let        | copyOut (T.GPR(T.REG(sz, r))::rest, results, stmts) = let
157            val t = C.newReg()            val t = C.newReg()
158          in copyOut(rest, gpr(sz, t)::results, T.COPY(sz,[t],[r])::stmts)            in
159                copyOut(rest, gpr(sz, t)::results, T.COPY(sz,[t],[r])::stmts)
160          end          end
161        | copyOut _ = error "copyOut"        | copyOut _ = error "copyOut"
162    end      end (* local *)
163    
164    fun genCall ar = let    fun genCall ar = let
165      val {name,proto,structRet,saveRestoreDedicated, callComment,args} = ar            val {
166                    name, proto, paramAlloc, structRet,
167                    saveRestoreDedicated, callComment, args
168                  } = ar
169      val {conv, retTy, paramTys} = proto      val {conv, retTy, paramTys} = proto
170      val callee_pops =            val calleePops = (case conv
171          case conv of                   of (""|"ccall") => false
             (""|"ccall") => false  
172            | "stdcall" => true            | "stdcall" => true
173            | _ => error (concat ["unknown calling convention \"",                    | _ => error (concat [
174                                  String.toString conv, "\""])                          "unknown calling convention \"", String.toString conv, "\""
175                        ])
176                    (* end case *))
177      fun push signed {sz, e} = let      fun push signed {sz, e} = let
178        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))
179        fun signExtend(e) = if sz=32 then e else T.SX(32, sz, e)        fun signExtend(e) = if sz=32 then e else T.SX(32, sz, e)
# Line 287  Line 291 
291                        of (Ty.C_void, _) => error "STRUCT: void field"                        of (Ty.C_void, _) => error "STRUCT: void field"
292                         | (Ty.C_float, FARG fexp)         => cont(pushf(32,fexp))                         | (Ty.C_float, FARG fexp)         => cont(pushf(32,fexp))
293                         | (Ty.C_double, FARG fexp)        => cont(pushf(64, fexp))                         | (Ty.C_double, FARG fexp)        => cont(pushf(64, fexp))
294                         | (Ty.C_long_double, FARG fexp)   => cont(pushf(80, fexp))                               | (Ty.C_long_double, FARG fexp) =>
295                         | (Ty.C_unsigned(cint), ARG rexp) => pushCint(cint, rexp)                                    cont(pushf(80, fexp))
296                                 | (Ty.C_unsigned(cint), ARG rexp) =>
297                                      pushCint(cint, rexp)
298                         | (Ty.C_signed(cint), ARG rexp)   => pushCint(cint, rexp)                         | (Ty.C_signed(cint), ARG rexp)   => pushCint(cint, rexp)
299                         | (Ty.C_PTR, ARG rexp)            => pushl(rexp)                         | (Ty.C_PTR, ARG rexp)            => pushl(rexp)
300                         | (Ty.C_ARRAY _, ARG rexp)        => pushl(rexp)                         | (Ty.C_ARRAY _, ARG rexp)        => pushl(rexp)
# Line 296  Line 302 
302                             val (ldPtr, args) = mkStructArgs(fields, rexp)                             val (ldPtr, args) = mkStructArgs(fields, rexp)
303                           in cont(ldPtr::pushStruct(fields, args, stmts))                           in cont(ldPtr::pushStruct(fields, args, stmts))
304                           end                           end
305                         | (Ty.C_STRUCT fields, ARGS rexps) => let                               | (Ty.C_STRUCT fields, ARGS rexps) =>
306                           in cont(pushStruct(fields, rexps, stmts))                                    cont(pushStruct(fields, rexps, stmts))
                          end  
307                      end (* pushStruct *)                      end (* pushStruct *)
308               in pushArgs(r1, r2, pad16(fields, pushStruct(fields, args, stmts)))                        in
309                            pushArgs(r1, r2,
310                              pad16(fields, pushStruct(fields, args, stmts)))
311               end               end
312             | _ => error "argument/parameter mismatch"             | _ => error "argument/parameter mismatch"
313           (* end case *)           (* end case *)
# Line 308  Line 315 
315        | pushArgs _ = error "argument/parameter mismatch"        | pushArgs _ = error "argument/parameter mismatch"
316    
317      (* struct return address is an implicit 0th argument*)      (* struct return address is an implicit 0th argument*)
318      fun pushStructRetAddr (acc) =            fun pushStructRetAddr (acc) = (case retTy
      (case retTy  
319        of Ty.C_STRUCT fields => let        of Ty.C_STRUCT fields => let
320             val addr = structRet{szb=structSz fields, align=0}             val addr = structRet{szb=structSz fields, align=0}
321           in unsigned{sz=32, e=addr}::acc                        in
322                            unsigned{sz=32, e=addr}::acc
323           end           end
324         | _ => acc         | _ => acc
325       (*esac*))                  (* end case *))
326    
327      (* call defines callersave registers and uses result registers. *)      (* call defines callersave registers and uses result registers. *)
328      fun mkCall (defs, npop) = let      fun mkCall (defs, npop) = let
# Line 351  Line 358 
358      (* size to pop off on return *)      (* size to pop off on return *)
359      fun argsSz(Ty.C_STRUCT fields::rest) = let      fun argsSz(Ty.C_STRUCT fields::rest) = let
360            val sz = structSz fields            val sz = structSz fields
361            fun pad16 bytes =                  fun pad16 bytes = (case Word.andb(Word.fromInt sz, 0w1)
             (case Word.andb(Word.fromInt sz, 0w1)  
362               of 0w0 => sz               of 0w0 => sz
363                | 0w1 => sz+1                | 0w1 => sz+1
364              (*esac*))                        (* end case *))
365          in pad16 sz + argsSz(rest)                  in
366                      pad16 sz + argsSz(rest)
367          end          end
368        | argsSz(ty::rest) =        | argsSz(ty::rest) =
369          (* remember that char and short get promoted... *)          (* remember that char and short get promoted... *)
370          Int.max(sizeOf(ty),4)+argsSz(rest)          Int.max(sizeOf(ty),4)+argsSz(rest)
371        | argsSz [] = 0        | argsSz [] = 0
372    
   
373      val (cRets, cDefs) = resultsAndDefs (retTy)      val (cRets, cDefs) = resultsAndDefs (retTy)
374      val (retRegs, cpyOut) = copyOut(cRets, [], [])      val (retRegs, cpyOut) = copyOut(cRets, [], [])
375      val n = argsSz paramTys      val n = argsSz paramTys
376      val (popseq, implicit_pop) =      val (popseq, implicit_pop) =
377          if callee_pops orelse n = 0 then ([], n)                if calleePops orelse n = 0 then ([], n)
378          else ([T.MV(32, sp, T.ADD(32, T.REG(32,sp), LI n))], 0)          else ([T.MV(32, sp, T.ADD(32, T.REG(32,sp), LI n))], 0)
379      val call = mkCall(cDefs, implicit_pop) @ popseq @ cpyOut      val call = mkCall(cDefs, implicit_pop) @ popseq @ cpyOut
380      val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))      val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))
381    in {callseq=callSeq, result=retRegs}            in
382    end              {callseq=callSeq, result=retRegs}
383              end (* genCall *)
384    
385  end  end
386    

Legend:
Removed from v.1042  
changed lines
  Added in v.1043

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