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 773, Mon Jan 8 16:18:37 2001 UTC revision 774, Wed Jan 10 12:50:56 2001 UTC
# Line 58  Line 58 
58      | FARG of T.fexp      | FARG of T.fexp
59      | ARGS of c_arg list      | ARGS of c_arg list
60    
61    val mem = T.Region.memory    fun genCall0 use_tmpsp
62                   {name, proto={conv="", retTy, paramTys}, structRet, args} =
63          let val mem = T.Region.memory
64    val stack = T.Region.memory    val stack = T.Region.memory
65    
66    (* map C integer types to their MLRisc type *)    (* map C integer types to their MLRisc type *)
# Line 91  Line 93 
93          List.foldl  (fn (fld, sum) => sizeOf fld + sum) 0 fields          List.foldl  (fn (fld, sum) => sizeOf fld + sum) 0 fields
94    
95    val sp = C.esp    val sp = C.esp
96    
97              val mysp = if use_tmpsp then C.newReg () else sp
98    
99    fun LI i = T.LI(T.I.fromInt(32, i))    fun LI i = T.LI(T.I.fromInt(32, i))
100    
101    local    local
102      fun fpr(sz,f) = T.FPR(T.FREG(sz, f))      fun fpr(sz,f) = T.FPR(T.FREG(sz, f))
103      fun gpr(sz,r) = T.GPR(T.REG(sz, r))      fun gpr(sz,r) = T.GPR(T.REG(sz, r))
104      val st0 = C.ST(0)      val st0 = C.ST(0)
105    (* note that the caller saves includes the result register (%eax) *)                (* note that caller saves include the result register (%eax) *)
106      val callerSaves = [gpr(32, C.eax), gpr(32, C.ecx), gpr(32, C.edx)]                val callerSaves =
107                      [gpr(32, C.eax), gpr(32, C.ecx), gpr(32, C.edx)]
108      val oneRes = [gpr(32, C.eax)]      val oneRes = [gpr(32, C.eax)]
109      val twoRes = [gpr(32, C.edx), gpr(32, C.eax)]      val twoRes = [gpr(32, C.edx), gpr(32, C.eax)]
110    in    in
111     (* List of registers defined by a C Call; this is the result registers            (* List of registers defined by a C Call; this is the result
112      * plus the caller save registers.             * registers plus the caller save registers.
113      * Multiple returns have most significant register first.      * Multiple returns have most significant register first.
114      *)      *)
115      fun resultsAndDefs (Ty.C_void) = ([], callerSaves)      fun resultsAndDefs (Ty.C_void) = ([], callerSaves)
# Line 144  Line 150 
150        | copyOut _ = error "copyOut"        | copyOut _ = error "copyOut"
151    end    end
152    
153    fun genCall{name, proto={conv="", retTy, paramTys}, structRet, args} = let            fun bumpSp sz = T.MV(32, mysp, T.SUB(32, T.REG(32,mysp), LI sz))
154              fun storeAtSp(sz, e) = T.STORE(sz, T.REG(32,mysp), e, stack)
155    
156      fun push signed {sz, e} = let      fun push signed {sz, e} = let
157        fun pushl rexp = T.EXT(ix(IX.PUSHL(rexp)))                fun real_pushl rexp = [T.EXT(ix(IX.PUSHL(rexp)))]
158                  fun fake_pushl rexp = [bumpSp(4),storeAtSp(32,rexp)]
159                  val pushl = if use_tmpsp then fake_pushl else real_pushl
160        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)
161        fun zeroExtend(e) = if sz=32 then e else T.ZX(32, sz, e)        fun zeroExtend(e) = if sz=32 then e else T.ZX(32, sz, e)
162      in      in
# Line 157  Line 167 
167    
168      fun push64 rexp = error "push64"      fun push64 rexp = error "push64"
169      (* increment the stack pointer and store floating point result. *)      (* increment the stack pointer and store floating point result. *)
     fun bumpSp sz = T.MV(32, sp, T.SUB(32, T.REG(32,sp), LI sz))  
     fun storeAtSp(sz, e) = T.STORE(sz, T.REG(32,sp), e, stack)  
170      fun PUSHB(e, stmts) = bumpSp(1)::storeAtSp(8, e)::stmts      fun PUSHB(e, stmts) = bumpSp(1)::storeAtSp(8, e)::stmts
171      fun PUSHW(e, stmts) = bumpSp(2)::storeAtSp(16, e)::stmts      fun PUSHW(e, stmts) = bumpSp(2)::storeAtSp(16, e)::stmts
172    
173      fun fst32 fexp = [bumpSp(4), T.FSTORE(32, T.REG(32, sp), fexp, stack)]            fun fst32 fexp =
174      fun fst64 fexp = [bumpSp(8), T.FSTORE(64, T.REG(32, sp), fexp, stack)]                [bumpSp(4), T.FSTORE(32, T.REG(32,mysp), fexp, stack)]
175      fun fst80 fexp = [bumpSp(10), T.FSTORE(80, T.REG(32, sp), fexp, stack)]            fun fst64 fexp =
176                  [bumpSp(8), T.FSTORE(64, T.REG(32,mysp), fexp, stack)]
177              fun fst80 fexp =
178                  [bumpSp(10), T.FSTORE(80, T.REG(32,mysp), fexp, stack)]
179    
180      fun pushArgs ([], [], stmts) = stmts      fun pushArgs ([], [], stmts) = stmts
181        | pushArgs (param::r1, arg::r2, stmts) = let        | pushArgs (param::r1, arg::r2, stmts) = let
# Line 174  Line 185 
185            fun pad16(fields, stmts) = let            fun pad16(fields, stmts) = let
186              val sz = structSz fields              val sz = structSz fields
187            in            in
188              case Word.andb(Word.fromInt sz, 0w1)                        if Word.andb(Word.fromInt sz, 0w1) = 0w0 then stmts
189               of 0w0 => stmts                        else bumpSp(1)::stmts
               | 0w1 => bumpSp(1)::stmts  
             (*esac*)  
190            end            end
191            fun mkStructArgs(fields, rexp) = let            fun mkStructArgs(fields, rexp) = let
192              val ptrR = C.newReg()              val ptrR = C.newReg()
# Line 215  Line 224 
224             | (Ty.C_double, FARG fexp) => nextL(fst64 fexp)             | (Ty.C_double, FARG fexp) => nextL(fst64 fexp)
225             | (Ty.C_long_double, FARG fexp) => nextL(fst80 fexp)             | (Ty.C_long_double, FARG fexp) => nextL(fst80 fexp)
226             | (Ty.C_unsigned(Ty.I_char), ARG rexp) =>             | (Ty.C_unsigned(Ty.I_char), ARG rexp) =>
227                  next(unsigned{sz=8, e=rexp})                        nextL(unsigned{sz=8, e=rexp})
228             | (Ty.C_unsigned(Ty.I_short), ARG rexp) =>             | (Ty.C_unsigned(Ty.I_short), ARG rexp) =>
229                  next(unsigned{sz=16, e=rexp})                        nextL(unsigned{sz=16, e=rexp})
230             | (Ty.C_unsigned(Ty.I_int), ARG rexp) =>             | (Ty.C_unsigned(Ty.I_int), ARG rexp) =>
231                  next(unsigned{sz=32, e=rexp})                        nextL(unsigned{sz=32, e=rexp})
232             | (Ty.C_unsigned(Ty.I_long), ARG rexp) =>             | (Ty.C_unsigned(Ty.I_long), ARG rexp) =>
233                  next(unsigned{sz=32, e=rexp})                        nextL(unsigned{sz=32, e=rexp})
234             | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) =>             | (Ty.C_unsigned(Ty.I_long_long), ARG rexp) =>
235                  next(push64(rexp))                  next(push64(rexp))
236             | (Ty.C_signed(Ty.I_char), ARG rexp) => next(signed{sz=8, e=rexp})                      | (Ty.C_signed(Ty.I_char), ARG rexp) =>
237             | (Ty.C_signed(Ty.I_short), ARG rexp) => next(signed{sz=16, e=rexp})                        nextL(signed{sz=8, e=rexp})
238             | (Ty.C_signed(Ty.I_int), ARG rexp) => next(signed{sz=32, e=rexp})                      | (Ty.C_signed(Ty.I_short), ARG rexp) =>
239             | (Ty.C_signed(Ty.I_long), ARG rexp) => next(signed{sz=32, e=rexp})                        nextL(signed{sz=16, e=rexp})
240             | (Ty.C_signed(Ty.I_long_long), ARG rexp) => next(push64 rexp)                      | (Ty.C_signed(Ty.I_int), ARG rexp) =>
241             | (Ty.C_PTR, ARG rexp) => next(unsigned{sz=32, e=rexp})                        nextL(signed{sz=32, e=rexp})
242             | (Ty.C_ARRAY _, ARG rexp) => next(unsigned{sz=32, e=rexp})                      | (Ty.C_signed(Ty.I_long), ARG rexp) =>
243                          nextL(signed{sz=32, e=rexp})
244                        | (Ty.C_signed(Ty.I_long_long), ARG rexp) =>
245                          next(push64 rexp)
246                        | (Ty.C_PTR, ARG rexp) =>
247                          nextL(unsigned{sz=32, e=rexp})
248                        | (Ty.C_ARRAY _, ARG rexp) =>
249                          nextL(unsigned{sz=32, e=rexp})
250             | (Ty.C_STRUCT fields, ARG rexp) => let             | (Ty.C_STRUCT fields, ARG rexp) => let
251                  val (ldPtr, args) = mkStructArgs(fields, rexp)                  val (ldPtr, args) = mkStructArgs(fields, rexp)
252                  val stmts = pushArgs([param], [ARGS(args)], stmts)                  val stmts = pushArgs([param], [ARGS(args)], stmts)
# Line 239  Line 255 
255             | (Ty.C_STRUCT fields, ARGS args) => let             | (Ty.C_STRUCT fields, ARGS args) => let
256                  fun pushStruct([], [], stmts) = stmts                  fun pushStruct([], [], stmts) = stmts
257                    | pushStruct(ty::tys, arg::args, stmts) = let                    | pushStruct(ty::tys, arg::args, stmts) = let
258                        fun cont(stmts) = pushStruct(tys, args, stmts)                                    fun cont(stmts) =
259                                          pushStruct(tys, args, stmts)
260                        fun pushf(sz, fexp) =                        fun pushf(sz, fexp) =
261                          (case sz                          (case sz
262                           of 32 => fst32(fexp)                           of 32 => fst32(fexp)
# Line 248  Line 265 
265                           (*esac*)) @ stmts                           (*esac*)) @ stmts
266                        fun pushb (rexp) = cont(PUSHB(rexp, stmts))                        fun pushb (rexp) = cont(PUSHB(rexp, stmts))
267                        fun pushw (rexp) = cont(PUSHW(rexp, stmts))                        fun pushw (rexp) = cont(PUSHW(rexp, stmts))
268                        fun pushl (rexp) = cont(T.EXT(ix(IX.PUSHL(rexp)))::stmts)                                    fun real_pushl (rexp) =
269                                          cont(T.EXT(ix(IX.PUSHL(rexp)))::stmts)
270                                      fun fake_pushl (rexp) =
271                                          cont(bumpSp(4)::storeAtSp(32,rexp)
272                                               ::stmts)
273                                      val pushl = if use_tmpsp then fake_pushl
274                                                  else real_pushl
275                        fun pushCint(cint, rexp) =                        fun pushCint(cint, rexp) =
276                         (case cint                         (case cint
277                          of Ty.I_char => pushb(rexp)                          of Ty.I_char => pushb(rexp)
278                           | Ty.I_short => pushw(rexp)                           | Ty.I_short => pushw(rexp)
279                           | Ty.I_int => pushl(rexp)                           | Ty.I_int => pushl(rexp)
280                           | Ty.I_long => pushl(rexp)                           | Ty.I_long => pushl(rexp)
281                           | Ty.I_long_long => error "STRUCT: long_long"                                           | Ty.I_long_long =>
282                                               error "STRUCT: long_long"
283                         (*esac*))                         (*esac*))
284                      in                      in
285                        case (ty, arg)                        case (ty, arg)
286                        of (Ty.C_void, _) => error "STRUCT: void field"                                     of (Ty.C_void, _) =>
287                         | (Ty.C_float, FARG fexp)         => cont(pushf(32,fexp))                                        error "STRUCT: void field"
288                         | (Ty.C_double, FARG fexp)        => cont(pushf(64, fexp))                                      | (Ty.C_float, FARG fexp) =>
289                         | (Ty.C_long_double, FARG fexp)   => cont(pushf(80, fexp))                                        cont(pushf(32,fexp))
290                         | (Ty.C_unsigned(cint), ARG rexp) => pushCint(cint, rexp)                                      | (Ty.C_double, FARG fexp) =>
291                         | (Ty.C_signed(cint), ARG rexp)   => pushCint(cint, rexp)                                        cont(pushf(64, fexp))
292                         | (Ty.C_PTR, ARG rexp)            => pushl(rexp)                                      | (Ty.C_long_double, FARG fexp) =>
293                         | (Ty.C_ARRAY _, ARG rexp)        => pushl(rexp)                                        cont(pushf(80, fexp))
294                                        | (Ty.C_unsigned(cint), ARG rexp) =>
295                                          pushCint(cint, rexp)
296                                        | (Ty.C_signed(cint), ARG rexp) =>
297                                          pushCint(cint, rexp)
298                                        | (Ty.C_PTR, ARG rexp) =>
299                                          pushl(rexp)
300                                        | (Ty.C_ARRAY _, ARG rexp) =>
301                                          pushl(rexp)
302                         | (Ty.C_STRUCT fields, ARG rexp)  => let                         | (Ty.C_STRUCT fields, ARG rexp)  => let
303                             val (ldPtr, args) = mkStructArgs(fields, rexp)                                            val (ldPtr, args) =
304                           in cont(ldPtr::pushStruct(fields, args, stmts))                                                mkStructArgs(fields, rexp)
305                                          in cont(ldPtr::pushStruct
306                                                             (fields, args, stmts))
307                           end                           end
308                         | (Ty.C_STRUCT fields, ARGS rexps) => let                         | (Ty.C_STRUCT fields, ARGS rexps) => let
309                           in cont(pushStruct(fields, rexps, stmts))                           in cont(pushStruct(fields, rexps, stmts))
310                           end                           end
311                      end (* pushStruct *)                      end (* pushStruct *)
312               in pushArgs(r1, r2, pad16(fields, pushStruct(fields, args, stmts)))                        in pushArgs(r1, r2,
313                                      pad16(fields,
314                                            pushStruct(fields, args, stmts)))
315               end               end
316             | _ => error "argument/parameter mismatch"             | _ => error "argument/parameter mismatch"
317           (* end case *)           (* end case *)
# Line 287  Line 323 
323       (case retTy       (case retTy
324        of Ty.C_STRUCT fields => let        of Ty.C_STRUCT fields => let
325             val addr = structRet{szb=structSz fields, align=0}             val addr = structRet{szb=structSz fields, align=0}
326           in unsigned{sz=32, e=addr}::acc                     in unsigned{sz=32, e=addr}@acc
327           end           end
328         | _ => acc         | _ => acc
329       (*esac*))       (*esac*))
330    
331      (* call defines callersave registers and uses result registers. *)      (* call defines callersave registers and uses result registers. *)
332      fun mkCall defs = T.CALL{            fun mkCall (defs, 0) =
333              funct=name, targets=[], defs=defs, uses=[],                [T.CALL { funct = name, targets = [], defs = defs, uses = [],
334              region=T.Region.memory                          region = T.Region.memory }]
335            }              | mkCall (defs, n) = let
336                      fun call f = T.CALL { funct = f, targets = [],
337                                            defs = defs, uses = [],
338                                            region=T.Region.memory }
339                      val pop = T.MV (32, sp, T.ADD (32, T.REG (32, sp), LI n))
340                  in
341                      if use_tmpsp then [T.MV (32, C.eax, name),
342                                         T.MV (32, sp, T.REG(32,mysp)),
343                                         call (T.REG(32,C.eax)),
344                                         pop]
345                      else [call name, pop]
346                  end
347    
348      (* size to pop off on return *)      (* size to pop off on return *)
349      fun argsSz(Ty.C_STRUCT fields::rest) = let            fun argsSz(Ty.C_STRUCT fields::rest) =
350            val sz = structSz fields                let val sz = structSz fields
351            fun pad16 bytes =            fun pad16 bytes =
352              (case Word.andb(Word.fromInt sz, 0w1)                        if Word.andb(Word.fromInt sz, 0w1) = 0w0 then sz
353               of 0w0 => sz                        else sz + 1
               | 0w1 => sz+1  
             (*esac*))  
354          in pad16 sz + argsSz(rest)          in pad16 sz + argsSz(rest)
355          end          end
356        | argsSz(ty::rest) = sizeOf(ty)+argsSz(rest)        | argsSz(ty::rest) = sizeOf(ty)+argsSz(rest)
357        | argsSz [] = 0        | argsSz [] = 0
358    
   
359      val (cRets, cDefs) = resultsAndDefs (retTy)      val (cRets, cDefs) = resultsAndDefs (retTy)
360      val (retRegs, cpyOut) = copyOut(cRets, [], [])      val (retRegs, cpyOut) = copyOut(cRets, [], [])
361      val call = mkCall(cDefs) :: (case argsSz paramTys            val call = mkCall(cDefs, argsSz paramTys) @ cpyOut
362           of 0 => cpyOut            val callSeq0 = pushArgs(paramTys, args, pushStructRetAddr(call))
363            | n => T.MV(32, sp, T.ADD(32, T.REG(32,sp), LI n)) :: cpyOut            val callSeq =
364          (* end case *))                if use_tmpsp then T.MV(32,mysp,T.REG(32,sp)) :: callSeq0
365      val callSeq = pushArgs(paramTys, args, pushStructRetAddr(call))                else callSeq0
366    in {callseq=callSeq, result=retRegs}    in {callseq=callSeq, result=retRegs}
367    end    end
368      | genCall {proto={conv, ...}, ...} =      | genCall0 _ {proto={conv, ...}, ...} =
369          error(concat["unknown calling convention \"", String.toString conv, "\""])        error(concat["unknown calling convention \"",
370                       String.toString conv, "\""])
371    
372      val genCall = genCall0 false
373      val tmpsp_genCall = genCall0 true
374  end  end

Legend:
Removed from v.773  
changed lines
  Added in v.774

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