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 /MLRISC/trunk/amd64/staged-allocation/amd64-svid.sml
ViewVC logotype

Diff of /MLRISC/trunk/amd64/staged-allocation/amd64-svid.sml

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

revision 2925, Wed Jan 9 17:34:12 2008 UTC revision 2926, Wed Jan 16 19:45:13 2008 UTC
# Line 160  Line 160 
160          argLoc argOffset (w', loc, k)          argLoc argOffset (w', loc, k)
161        | argLoc _ (w, S.COMBINE _, _) = raise Fail "impossible"        | argLoc _ (w, S.COMBINE _, _) = raise Fail "impossible"
162    
163       (* takes a calling convention, return type, and param types and returns locations for setting up the call *)
164      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
165          val {call={cS0, cStep, finish}, ret={rS0, rStep}} =          val {call={cS0, cStep, finish}, ret={rS0, rStep}} = SVIDConventions.genAutomaton ()
166                   SVIDConventions.genAutomaton ()          (* generate locations for the return  *)
         (* return *)  
167          fun rLoc () = argLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))          fun rLoc () = argLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))
168          val (resLoc, structRetLoc, argOffset) = (case retTy          val (resLoc, structRetLoc, argOffset) = (case retTy
169               of CTy.C_void => (NONE, NONE, 0)               of CTy.C_void => (NONE, NONE, 0)
# Line 176  Line 176 
176                | _ => (SOME (rLoc ()), NONE, 0)                | _ => (SOME (rLoc ()), NONE, 0)
177               (* end case *))               (* end case *))
178          val argLoc = argLoc argOffset          val argLoc = argLoc argOffset
179          (* call *)          (* generate locations for the call *)
180          fun assign (str, [], locs) = (finish str, rev locs)          fun assign (str, [], locs) = (finish str, rev locs)
181            | assign (str, pTy :: pTys, locs) = let            | assign (str, pTy :: pTys, locs) = let
182              val (str', cLoc) = cStep (str, cTyToLoc pTy)              val (str', cLoc) = cStep (str, cTyToLoc pTy)
# Line 185  Line 185 
185                  assign (str', pTys, loc:: locs)                  assign (str', pTys, loc:: locs)
186              end (* assign *)              end (* assign *)
187          val (frameSz, argLocs) = assign (cS0, paramTys, [])          val (frameSz, argLocs) = assign (cS0, paramTys, [])
188          val argMem = {szb=CSizes.alignAddr (frameSz, frameAlign),          val argMem = {szb=CSizes.alignAddr (frameSz, frameAlign), align=frameAlign}
                       align=frameAlign}  
189          in          in
190            {argLocs=argLocs, resLoc=resLoc, argMem=argMem,            {argLocs=argLocs, resLoc=resLoc, argMem=argMem, structRetLoc=structRetLoc}
            structRetLoc=structRetLoc}  
191          end (* layout *)          end (* layout *)
192    
193      val spReg = T.REG (wordTy, C.rsp)      val spReg = T.REG (wordTy, C.rsp)
# Line 200  Line 198 
198                          then []                          then []
199                          else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,                          else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,
200                                T.LI (T.I.fromInt (wordTy, #szb argMem))))]                                T.LI (T.I.fromInt (wordTy, #szb argMem))))]
201          val copyArgs = let          val (copyArgs, gprUses, fprUses) = let
202              fun offSp 0 = spReg              fun offSp 0 = spReg
203                | offSp offset = T.ADD (wordTy, spReg, T.LI offset)                | offSp offset = T.ADD (wordTy, spReg, T.LI offset)
204              fun f ([], [], stms) = rev stms              fun f ([], [], stms, gprs, fprs) = (rev stms, gprs, fprs)
205                | f (arg :: args, loc :: locs, stms) = let                | f (arg :: args, loc :: locs, stms, gprs, fprs) = let
206                  val stms = (case (arg, loc)                  val (stms, gprs, fprs) = (case (arg, loc)
207                      of (ARG (e as T.REG _), C_STK (mty, offset)) =>                      of (ARG (e as T.REG _), C_STK (mty, offset)) =>
208                         T.STORE (wordTy, offSp offset, e, stack) :: stms                         (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)
209                       | (ARG e, C_STK (mty, offset)) => let                       | (ARG e, C_STK (mty, offset)) => let
210                         val tmp = C.newReg ()                         val tmp = C.newReg ()
211                         in                         in
212                           T.STORE (mty, offSp offset, T.REG (mty, tmp), stack) ::                           (T.STORE (mty, offSp offset, T.REG (mty, tmp), stack) ::T.MV (mty, tmp, e) :: stms, gprs, fprs)
                          T.MV (mty, tmp, e) :: stms  
213                         end                         end
214                       | (ARG e, C_GPR (mty, r)) => let                       | (ARG e, C_GPR (mty, r)) => let
215                         val tmp = C.newReg ()                         val tmp = C.newReg ()
216                         in                         in
217                           T.COPY (mty, [r], [tmp]) ::                           (T.COPY (mty, [r], [tmp]) :: T.MV (mty, tmp, e) :: stms, r :: gprs, fprs)
                          T.MV (mty, tmp, e) :: stms  
218                         end                         end
219                       | (FARG (e as T.FREG _), C_STK (mty, offset)) =>                       | (FARG (e as T.FREG _), C_STK (mty, offset)) =>
220                         T.FSTORE (mty, offSp offset, e, stack) :: stms                         (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)
221                       | (FARG e, C_STK (mty, offset)) => let                       | (FARG e, C_STK (mty, offset)) => let
222                         val tmp = C.newFreg ()                         val tmp = C.newFreg ()
223                         in                         in
224                           T.FSTORE (mty, offSp offset,                           (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) :: T.FMV (mty, tmp, e) :: stms, gprs, fprs)
                            T.FREG (mty, tmp), stack) ::  
                          T.FMV (mty, tmp, e) :: stms  
225                         end                         end
226                       | (FARG e, C_FPR (mty, r)) => let                       | (FARG e, C_FPR (mty, r)) => let
227                         val tmp = C.newFreg ()                         val tmp = C.newFreg ()
228                         in                         in
229                           T.FCOPY (mty, [r], [tmp]) ::                           (T.FCOPY (mty, [r], [tmp]) :: T.FMV (mty, tmp, e) :: stms, gprs, (mty, r) :: fprs)
                          T.FMV (mty, tmp, e) :: stms  
230                         end                         end
231                       | _ => raise Fail "todo"                       | _ => raise Fail "todo"
232                      (* end case *))                      (* end case *))
233                  in                  in
234                    f (args, locs, stms)                    f (args, locs, stms, gprs, fprs)
235                  end                  end
236                | f _ = raise Fail "argument arity error"                | f _ = raise Fail "argument arity error"
237              in              in
238                f (args, argLocs, [])                f (args, argLocs, [], [], [])
239              end              end
240         (* determine from the calling convention whether MLRISC needs to save registers over the call *)         (* the defined registers of the call depend on the calling convention *)
241          val defs = (case #conv proto          val defs = (case #conv proto
242              of "ccall" => map gpr callerSaveRegs @ map fpr callerSaveFRegs              of "ccall" => List.map gpr callerSaveRegs @ List.map fpr callerSaveFRegs
243               | "ccall-bare" => []               | "ccall-bare" => []
244               | conv => raise Fail (concat [               | conv => raise Fail (concat [
245                          "unknown calling convention \"", String.toString conv, "\""                          "unknown calling convention \"", String.toString conv, "\""
246                        ])                        ])
247              (* end case *))              (* end case *))
248          val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=[], region=mem, pops=0}          val uses = List.map gpr gprUses @ List.map fpr fprUses
249            val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}
250          val (resultRegs, copyResult) = (case resLoc          val (resultRegs, copyResult) = (case resLoc
251               of NONE => ([], [])               of NONE => ([], [])
252                | SOME (C_GPR (ty, r)) => let                | SOME (C_GPR (ty, r)) => let

Legend:
Removed from v.2925  
changed lines
  Added in v.2926

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