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 2985, Sun Apr 13 21:40:17 2008 UTC revision 2986, Mon Apr 14 07:03:16 2008 UTC
# Line 1  Line 1 
1  (* amd64-svid-fn.sml  (* amd64-svid-fn.sml
2   *   *
3   * C calling conventions using staged allocation.   * C calling conventions using staged allocation.
4     *
5   *)   *)
6    
7  functor AMD64SVID (  functor AMD64SVID (
8      structure T : MLTREE      structure T : MLTREE
     (* alignment requirement for stack frames; should be a power of two  
      * that is at least eight.  
      *)  
9      val frameAlign : int      val frameAlign : int
10    ) : C_CALL =    ) : C_CALL =
11    struct    struct
# Line 18  Line 16 
16      structure CTy = CTypes      structure CTy = CTypes
17    
18      val wordTy = 64      val wordTy = 64
     val stack = T.Region.stack  
19      val mem = T.Region.memory      val mem = T.Region.memory
20      fun gpr r = T.GPR (T.REG (wordTy, r))      fun gpr r = T.GPR (T.REG (wordTy, r))
21      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
22    
23      (* GPRs *)      (* general-purpose registers *)
24      val [rax, rbx, rdi, rsi, rdx, rcx, r8, r9, r10, r11, r12, r13, r14, r15] =      val [rax, rbx, rdi, rsi, rdx, rcx, r8, r9, r10, r11, r12, r13, r14, r15] =
25            map (fn r => (wordTy, r))            map (fn r => (wordTy, r))
26              ([C.rax, C.rbx, C.rdi, C.rsi, C.rdx, C.rcx] @              ([C.rax, C.rbx, C.rdi, C.rsi, C.rdx, C.rcx] @
27               C.Regs CB.GP {from=8, to=15, step=1})               C.Regs CB.GP {from=8, to=15, step=1})
28      (* FPRs *)      (* floating-point registers (SSE2) *)
29      val sseFRegs as      val sseFRegs as
30          [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, xmm8, xmm9, xmm10,          [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7, xmm8, xmm9, xmm10,
31           xmm11, xmm12, xmm13, xmm14, xmm15] =           xmm11, xmm12, xmm13, xmm14, xmm15] =
# Line 37  Line 34 
34      val callerSaveRegs = map #2 [rax, rcx, rdx, rsi, rdi, r8, r9, r10, r11]      val callerSaveRegs = map #2 [rax, rcx, rdx, rsi, rdi, r8, r9, r10, r11]
35      val callerSaveFRegs = sseFRegs      val callerSaveFRegs = sseFRegs
36      val calleeSaveFRegs = []      val calleeSaveFRegs = []
37        val spReg = T.REG (wordTy, C.rsp)
38    
     datatype c_arg  
       = ARG of T.rexp  
           (* rexp specifies integer or pointer; if the  
            * corresponding parameter is a C struct, then  
            * this argument is the address of the struct.  
            *)  
       | FARG of T.fexp  
           (* fexp specifies floating-point argument *)  
       | ARGS of c_arg list  
           (* list of arguments corresponding to the contents of a C struct *)  
39      datatype location_kind = K_GPR | K_FPR | K_MEM      datatype location_kind = K_GPR | K_FPR | K_MEM
40      structure TargetLang =      structure S = StagedAllocationFn (
41        struct                                    structure T = T
42                                      structure TargetLang = struct
43          datatype location_kind = datatype location_kind          datatype location_kind = datatype location_kind
44        end        end
45      structure StagedAllocation = StagedAllocationFn (                                    val memSize = 8
46                                     )
47    
48        structure CCall = CCallStkFn (
49                                    structure C = AMD64Cells
50                                    structure T = T                                    structure T = T
51                                    structure TargetLang = TargetLang )                                  val spReg = spReg
52      structure S = StagedAllocation                                  val wordTy = wordTy
53                          )
54        datatype c_arg = datatype CCall.c_arg
55        datatype arg_location = datatype CCall.arg_location
56    
57      (* This structure contains the automaton used in staged allocation. *)      (* This structure contains the automaton used in staged allocation. *)
58      structure SVIDConventions =      structure SVIDConventions =
# Line 80  Line 76 
76          in          in
77            ( cStack, [cStack, cInt, cFloat],            ( cStack, [cStack, cInt, cFloat],
78              [ S.CHOICE [              [ S.CHOICE [
79                (* GPR *)                (* pass in general-purpose register *)
80                (fn (w, k, str) => k = K_GPR, S.SEQ [                (fn (w, k, str) => k = K_GPR, S.SEQ [
81                   S.WIDEN (fn w => Int.max (wordTy, w)),                   S.WIDEN (fn w => Int.max (wordTy, w)),
82                   S.BITCOUNTER cInt,                   S.BITCOUNTER cInt,
83                   S.REGS_BY_BITS (cInt, gprParams)] ),                   S.REGS_BY_BITS (cInt, gprParams)] ),
84                (* FPR *)                (* pass in floating point register *)
85                (fn (w, k, str) => k = K_FPR, S.SEQ [                (fn (w, k, str) => k = K_FPR, S.SEQ [
86                   S.WIDEN (fn w => Int.max (64, w)),                   S.WIDEN (fn w => Int.max (64, w)),
87                   S.BITCOUNTER cFloat,                   S.BITCOUNTER cFloat,
88                   S.REGS_BY_BITS (cFloat, fprParams) ]),                   S.REGS_BY_BITS (cFloat, fprParams) ]),
89                (* MEM *)                (* pass on the stack *)
90                (fn (w, k, str) => k = K_MEM,                (fn (w, k, str) => k = K_MEM,
91                   S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}) ],                   S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}) ],
92               S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}               S.OVERFLOW {counter=cStack, blockDirection=S.UP, maxAlign=maxAlign}
# Line 107  Line 103 
103          in          in
104            ( [cFloat, cInt],            ( [cFloat, cInt],
105              [ S.CHOICE [              [ S.CHOICE [
106               (* GPR *)               (* return in general-purpose register *)
107               (fn (w, k, str) => k = K_GPR,               (fn (w, k, str) => k = K_GPR,
108                  S.SEQ [S.WIDEN (fn w => Int.max (wordTy, w)), ssGpr]),                  S.SEQ [S.WIDEN (fn w => Int.max (wordTy, w)), ssGpr]),
109               (* FPR *)               (* return in floating-point register *)
110               (fn (w, k, str) => k = K_FPR,               (fn (w, k, str) => k = K_FPR,
111                  S.SEQ [S.WIDEN (fn w => Int.max (64, w)), ssFloat]),                  S.SEQ [S.WIDEN (fn w => Int.max (64, w)), ssFloat]),
112               (* MEM *)               (* return in a memory location *)
113               (fn (w, k, str) => k = K_MEM,               (fn (w, k, str) => k = K_MEM,
114  (* FIXME! *)  (* FIXME! *)
115                  ssGpr) ]                  ssGpr) ]
116                 ] )                 ] )
117          end (* return *)          end (* return *)
118    
119          (* For calls and returns, genAutomaton, initializes counters,          (* generate the finite automaton for the target machine's calling conventions *)
          * returns an initial store, and returns a stepper function.  
          * Calls also have a finisher function that returns the size  
          * of the argument area.  
          *)  
120          fun genAutomaton () = let          fun genAutomaton () = let
121              val (stackCounter, callCounters, callStates) = call ()              val (stackCounter, callCounters, callStates) = call ()
122              val (retCounters, retStates) = return ()              val (retCounters, retStates) = return ()
# Line 133  Line 125 
125            {call = {cS0=S.init callCounters,            {call = {cS0=S.init callCounters,
126                     cStep=S.mkStep callStates, finish=finish},                     cStep=S.mkStep callStates, finish=finish},
127             ret  = {rS0=S.init retCounters, rStep=S.mkStep retStates}}             ret  = {rS0=S.init retCounters, rStep=S.mkStep retStates}}
128          end (* genAutomaton *)          end
129    
130        end (* SVIDConventions *)        end (* SVIDConventions *)
131    
     (* An arg_location specifies the location of arguments/parameters  
      * for a C call.  Offsets are given with respect to the low end  
      * of the parameter area. *)  
     datatype arg_location =  
         C_GPR  of (T.ty * T.reg) (* integer/pointer argument in register *)  
       | C_FPR  of (T.fty * T.reg) (* floating-point argument in register *)  
       | C_STK  of (T.ty * T.I.machine_int)  (* integer/pointer argument on the call stack *)  
       | C_FSTK of (T.fty * T.I.machine_int) (* floating-point argument on the call stack *)  
   
132      fun kindOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = K_FPR      fun kindOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = K_FPR
133        | kindOfCTy (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _) = K_MEM        | kindOfCTy (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _) = K_MEM
134        | kindOfCTy _ = K_GPR        | kindOfCTy _ = K_GPR
135      fun szToLoc cty {sz, align} = (sz * 8, kindOfCTy cty, align)      fun szToLoc cty {sz, align} = (sz * 8, kindOfCTy cty, align)
136      fun cTyToLoc cty = szToLoc cty (CSizes.sizeOfTy cty)      fun cTyToLoc cty = szToLoc cty (CSizes.sizeOfTy cty)
137        (* convert a C argument to a location for staged allocation *)
138      fun argLoc _ (w, S.REG (_, r), K_GPR) = C_GPR (w, r)      fun argLoc _ (w, S.REG (_, r), K_GPR) = C_GPR (w, r)
139        | argLoc _ (w, S.REG (_, r), K_FPR) = C_FPR (w, r)        | argLoc _ (w, S.REG (_, r), K_FPR) = C_FPR (w, r)
140        | argLoc argOffset (w, S.BLOCK_OFFSET offB, K_GPR) =        | argLoc argOffset (w, S.BLOCK_OFFSET offB, K_GPR) =
# Line 160  Line 143 
143          argLoc argOffset (w', loc, k)          argLoc argOffset (w', loc, k)
144        | argLoc _ (w, S.COMBINE _, _) = raise Fail "impossible"        | argLoc _ (w, S.COMBINE _, _) = raise Fail "impossible"
145    
    (* takes a calling convention, return type, and param types and returns locations for setting up the call *)  
146      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
147          val {call={cS0, cStep, finish}, ret={rS0, rStep}} = SVIDConventions.genAutomaton ()          val {call={cS0, cStep, finish}, ret={rS0, rStep}} = SVIDConventions.genAutomaton ()
148          (* generate locations for the return  *)          (* set up the return value of the call *)
149          fun rLoc () = argLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))          fun setupReturn () = argLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))
150          val (resLoc, structRetLoc, argOffset) = (case retTy          val (resLoc, structRetLoc, argOffset) = (case retTy
151               of CTy.C_void => (NONE, NONE, 0)               of CTy.C_void => (NONE, NONE, 0)
152                | CTy.C_UNION tys => raise Fail "todo"                | CTy.C_UNION tys => raise Fail "todo"
153                | CTy.C_STRUCT tys => let                | CTy.C_STRUCT tys => let
154                  val {sz, align} = CSizes.sizeOfStruct tys                  val {sz, align} = CSizes.sizeOfStruct tys
155                  in                  in
156                    (SOME (rLoc ()), SOME {szb=sz, align=align}, 8)                    (SOME (setupReturn ()), SOME {szb=sz, align=align}, 8)
157                  end                  end
158                | _ => (SOME (rLoc ()), NONE, 0)                | _ => (SOME (setupReturn ()), NONE, 0)
159               (* end case *))               (* end case *))
160          val argLoc = argLoc argOffset          (* set up the arguments for the call *)
161          (* generate locations for the call *)          fun setupArgs (str, [], locs) = (finish(str), List.rev locs)
162          fun assign (str, [], locs) = (finish str, rev locs)            | setupArgs (str, pTy :: pTys, locs) = let
           | assign (str, pTy :: pTys, locs) = let  
163              val (str', cLoc) = cStep (str, cTyToLoc pTy)              val (str', cLoc) = cStep (str, cTyToLoc pTy)
             val loc = argLoc cLoc  
164              in              in
165                  assign (str', pTys, loc:: locs)                  setupArgs (str', pTys, argLoc argOffset cLoc :: locs)
166              end (* assign *)              end
167          val (frameSz, argLocs) = assign (cS0, paramTys, [])          val (frameSz, argLocs) = setupArgs (cS0, paramTys, [])
168          val argMem = {szb=CSizes.alignAddr (frameSz, frameAlign), align=frameAlign}          val argMem = {szb=CSizes.alignAddr (frameSz, frameAlign), align=frameAlign}
169          in          in
170            {argLocs=argLocs, resLoc=resLoc, argMem=argMem, structRetLoc=structRetLoc}            {argLocs=argLocs, argMem=argMem, resLoc=resLoc, structRetLoc=structRetLoc}
171          end (* layout *)          end
   
     val spReg = T.REG (wordTy, C.rsp)  
172    
173      fun genCall {name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args} = let      fun genCall {name, proto, paramAlloc, structRet, saveRestoreDedicated, callComment, args} = let
174          val {argLocs, argMem, resLoc, structRetLoc} = layout proto          val {argLocs, argMem, resLoc, structRetLoc} = layout(proto)
175          val argAlloc = if ((#szb argMem = 0) orelse paramAlloc argMem)          val argAlloc = if ((#szb argMem = 0) orelse paramAlloc argMem)
176                          then []                          then []
177                          else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,                          else [T.MV (wordTy, C.rsp, T.SUB (wordTy, spReg,
178                                T.LI (T.I.fromInt (wordTy, #szb argMem))))]                                T.LI (T.I.fromInt (wordTy, #szb argMem))))]
179          val (copyArgs, gprUses, fprUses) = let          val (copyArgs, gprUses, fprUses) = CCall.copyArgs(args, argLocs)
             fun offSp 0 = spReg  
               | offSp offset = T.ADD (wordTy, spReg, T.LI offset)  
             fun f ([], [], stms, gprs, fprs) = (rev stms, gprs, fprs)  
               | f (arg :: args, loc :: locs, stms, gprs, fprs) = let  
                 val (stms, gprs, fprs) = (case (arg, loc)  
                     of (ARG (e as T.REG _), C_STK (mty, offset)) =>  
                        (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)  
                      | (ARG e, C_STK (mty, offset)) => let  
                        val tmp = C.newReg ()  
                        in  
                          (T.STORE (mty, offSp offset, T.REG (mty, tmp), stack) ::T.MV (mty, tmp, e) :: stms, gprs, fprs)  
                        end  
                      | (ARG e, C_GPR (mty, r)) => let  
                        val tmp = C.newReg ()  
                        in  
                          (T.COPY (mty, [r], [tmp]) :: T.MV (mty, tmp, e) :: stms, r :: gprs, fprs)  
                        end  
                      | (FARG (e as T.FREG _), C_STK (mty, offset)) =>  
                        (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)  
                      | (FARG e, C_STK (mty, offset)) => let  
                        val tmp = C.newFreg ()  
                        in  
                          (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) :: T.FMV (mty, tmp, e) :: stms, gprs, fprs)  
                        end  
                      | (FARG e, C_FPR (mty, r)) => let  
                        val tmp = C.newFreg ()  
                        in  
                          (T.FCOPY (mty, [r], [tmp]) :: T.FMV (mty, tmp, e) :: stms, gprs, (mty, r) :: fprs)  
                        end  
                      | _ => raise Fail "todo"  
                     (* end case *))  
                 in  
                   f (args, locs, stms, gprs, fprs)  
                 end  
               | f _ = raise Fail "argument arity error"  
             in  
               f (args, argLocs, [], [], [])  
             end  
180         (* the defined registers of the call depend on the calling convention *)         (* the defined registers of the call depend on the calling convention *)
181          val defs = (case #conv proto          val defs = (case #conv proto
182              of "ccall" => List.map gpr callerSaveRegs @ List.map fpr callerSaveFRegs              of "ccall" => List.map gpr callerSaveRegs @ List.map fpr callerSaveFRegs
# Line 247  Line 187 
187              (* end case *))              (* end case *))
188          val uses = List.map gpr gprUses @ List.map fpr fprUses          val uses = List.map gpr gprUses @ List.map fpr fprUses
189          val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}          val callStm = T.CALL {funct=name, targets=[], defs=defs, uses=uses, region=mem, pops=0}
190          val (resultRegs, copyResult) = (case resLoc          val (resultRegs, copyResult) = CCall.returnVals(resLoc)
              of NONE => ([], [])  
               | SOME (C_GPR (ty, r)) => let  
                 val resReg = C.newReg ()  
                 in  
                   ([T.GPR (T.REG (ty, resReg))],  
                    [T.COPY (ty, [resReg], [r])])  
                 end  
               | SOME (C_FPR (ty, r)) => let  
                 val resReg = C.newFreg ()  
                 in  
                    ([T.FPR (T.FREG (ty, resReg))],  
                     [T.FCOPY (ty, [resReg], [r])])  
                 end  
               (* end case *))  
191          val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult          val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult
192      in      in
193        {callseq=callSeq, result=resultRegs}        {callseq=callSeq, result=resultRegs}

Legend:
Removed from v.2985  
changed lines
  Added in v.2986

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