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 2994, Thu Apr 17 23:34:02 2008 UTC revision 2995, Fri Apr 18 06:59:04 2008 UTC
# Line 7  Line 7 
7  functor AMD64SVID (  functor AMD64SVID (
8      structure T : MLTREE      structure T : MLTREE
9      val frameAlign : int      val frameAlign : int
10    ) : C_CALL =    ) (*: C_CALL*) =
11    struct    struct
12    
13      structure T = T      structure T = T
# Line 76  Line 76 
76          val gprParams = [rdi, rsi, rdx, rcx, r8, r9]          val gprParams = [rdi, rsi, rdx, rcx, r8, r9]
77          val fprParams = [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7]          val fprParams = [xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7]
78          val maxAlign = 16          val maxAlign = 16
79          (* parameter-passing conventions *)          (* parameter passing conventions *)
80          fun call () = let          fun call () = let
81              val cStack = S.freshCounter ()              val cStack = S.freshCounter ()
82              val cInt = S.freshCounter ()              val cInt = S.freshCounter ()
# Line 103  Line 103 
103              end (* call *)              end (* call *)
104          val gprRets = [rax, rdx]          val gprRets = [rax, rdx]
105          val fprRets = [xmm0, xmm1]          val fprRets = [xmm0, xmm1]
106          (* value-returning conventions *)          (* return conventions *)
107          fun return () = let          fun return () = let
108              val (cFloat, ssFloat) = S.useRegs fprRets              val (cFloat, ssFloat) = S.useRegs fprRets
109              val (cInt, ssGpr) = S.useRegs gprRets              val (cInt, ssGpr) = S.useRegs gprRets
# Line 134  Line 134 
134              end              end
135        end (* SVIDConventions *)        end (* SVIDConventions *)
136    
 (* FIXME! *)  
     fun containsUnalignedFields cTy = false  
   
137      fun szOfCTy cTy = #sz (CSizes.sizeOfTy cTy)      fun szOfCTy cTy = #sz (CSizes.sizeOfTy cTy)
138      fun sum ls = List.foldl (op +) 0 ls      fun sum ls = List.foldl (op +) 0 ls
139    
# Line 160  Line 157 
157                | cTys => [eightByte1, #1(firstEightByte(cTys, []))]                | cTys => [eightByte1, #1(firstEightByte(cTys, []))]
158          end          end
159    
     (* eliminate unions and structs *)  
     fun flattenCTy cTy = (case cTy  
         of (CTy.C_STRUCT cTys |  
             CTy.C_UNION cTys ) => List.concat (List.map flattenCTy cTys)  
          | cTy => [cTy])  
   
160      fun combineKinds (k1, k2) = if (k1 = k2)      fun combineKinds (k1, k2) = if (k1 = k2)
161          then k1          then k1
162          else (case (k1, k2)          else (case (k1, k2)
# Line 191  Line 182 
182              combineKinds(k1, k2)              combineKinds(k1, k2)
183          end          end
184    
185        fun containsUnalignedFields cTy = (case cTy
186            of (CTy.C_STRUCT cTys | CTy.C_UNION cTys) =>
187               List.all (fn cTy => #sz (CSizes.sizeOfTy cTy) mod 8 = 0) cTys
188             | _ => false)
189    
190      (* classify a C type into its location kinds (aggregates might be passed in registers) *)      (* classify a C type into its location kinds (aggregates might be passed in registers) *)
191      fun kindsOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = [K_FPR]      fun kindsOfCTy (CTy.C_float | CTy.C_double | CTy.C_long_double) = [K_FPR]
192        | kindsOfCTy (cTy as (CTy.C_STRUCT cTys | CTy.C_UNION cTys)) = let        | kindsOfCTy (cTy as CTy.C_STRUCT cTys) = let
193          val {sz, align} = CSizes.sizeOfTy cTy          val {sz, align} = CSizes.sizeOfTy cTy
194          val flatCTy = flattenCTy cTy          val flatCTy = CTypes.flattenCTy cTy
195          in          in
196              if (sz > 2*8 orelse containsUnalignedFields cTy)              if (sz > 2*8 orelse containsUnalignedFields cTy)
197                 then [K_MEM]                 then List.tabulate (sz div 8, fn _ => K_MEM)
198                 else let                 else let
199                    val eightBytes = eightBytes flatCTy                    val eightBytes = eightBytes flatCTy
200                    in                    in
201                         List.map kindOfEightByte eightBytes                         List.map kindOfEightByte eightBytes
202                    end                    end
203          end          end
204          | kindsOfCTy (cTy as CTy.C_UNION cTys) = raise Fail "todo"
205        | kindsOfCTy (CTy.C_ARRAY (ty, len)) = raise Fail "todo"        | kindsOfCTy (CTy.C_ARRAY (ty, len)) = raise Fail "todo"
206        | kindsOfCTy _ = [K_GPR]        | kindsOfCTy _ = [K_GPR]
207    
# Line 215  Line 212 
212             (sz * 8, kindOfCTy cty, align)             (sz * 8, kindOfCTy cty, align)
213          end          end
214    
215        fun cTyToLocs cTy = let
216            val {sz, align} = CSizes.sizeOfTy cTy
217            val ks = kindsOfCTy cTy
218            in
219                List.map (fn k => (sz * 8, k, align)) ks
220            end
221    (*
222      (* convert a C type to a location for staged allocation *)      (* convert a C type to a location for staged allocation *)
223      fun cTyToLocs cTy = let      fun cTyToLocs cTy = let
224          val ks = kindsOfCTy cTy          val ks = kindsOfCTy cTy
# Line 223  Line 227 
227             case (cTy, ks)             case (cTy, ks)
228              of ( cTy, [k] ) => [(sz*8, k, align)]              of ( cTy, [k] ) => [(sz*8, k, align)]
229               (* cleave the type into two eightbytes *)               (* cleave the type into two eightbytes *)
230               | ( (CTy.C_STRUCT _ | CTy.C_UNION _), [k1, k2] ) => [(8*8, k1, 8), ((sz-8)*8, k2, 8)]               | (CTy.C_STRUCT _, [k1, k2]) => [(8*8, k1, 8), ((sz-8)*8, k2, 8)]
231               | _ => raise Fail "invalid C type"               | (CTy.C_STRUCT _, _) => raise Fail "todo"
232                 | _ => raise Fail "todo"
233          end          end
234    *)
235    
236      (* converts location information to an argument location in C *)      (* converts location information to an argument location in C *)
237      fun saInfoToCLoc _ (w, S.REG (_, r), K_GPR) = C_GPR (w, r)      fun saInfoToCLoc _ (w, S.REG (_, r), K_GPR) = C_GPR (w, r)
238        | saInfoToCLoc _ (w, S.REG (_, r), K_FPR) = C_FPR (w, r)        | saInfoToCLoc _ (w, S.REG (_, r), K_FPR) = C_FPR (w, r)
239        | saInfoToCLoc argOffset (w, S.BLOCK_OFFSET offB, K_GPR) = C_STK (w, T.I.fromInt (wordTy, offB+argOffset))        | saInfoToCLoc argOffset (w, S.BLOCK_OFFSET offB, (K_GPR | K_FPR | K_MEM)) =
240        | saInfoToCLoc argOffset (w, S.BLOCK_OFFSET offB, K_FPR) = C_STK (w, T.I.fromInt (wordTy, offB+argOffset))          C_STK (w, T.I.fromInt (wordTy, offB+argOffset))
241        | saInfoToCLoc argOffset (w, S.NARROW (loc, w', k), _) = saInfoToCLoc argOffset (w', loc, k)        | saInfoToCLoc argOffset (w, S.NARROW (loc, w', k), _) = saInfoToCLoc argOffset (w', loc, k)
       | saInfoToCLoc _ (w, _, K_MEM) = raise Fail "kmem"  
242        | saInfoToCLoc _ _ = raise Fail "impossible"        | saInfoToCLoc _ _ = raise Fail "impossible"
243    
244      fun layout {conv, retTy, paramTys} = let      fun layout {conv, retTy, paramTys} = let
# Line 242  Line 247 
247          fun returnSALocsToCLocs () = saInfoToCLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))          fun returnSALocsToCLocs () = saInfoToCLoc 0 (#2 (rStep (rS0, cTyToLoc retTy)))
248          val (resLoc, structRetLoc, argOffset) = (case retTy          val (resLoc, structRetLoc, argOffset) = (case retTy
249               of CTy.C_void => (NONE, NONE, 0)               of CTy.C_void => (NONE, NONE, 0)
250                | ( CTy.C_UNION tys | CTy.C_STRUCT tys ) => let                | CTy.C_STRUCT tys => let
251                  val {sz, align} = CSizes.sizeOfStruct tys                  val {sz, align} = CSizes.sizeOfStruct tys
252                  in                  in
253                    (SOME (returnSALocsToCLocs ()), SOME {szb=sz, align=align}, 8)                    (SOME (returnSALocsToCLocs ()), SOME {szb=sz, align=align}, 8)
254                  end                  end
255                  | CTy.C_UNION tys => let
256                    val {sz, align} = CSizes.sizeOfUnion tys
257                    in
258                      (SOME (returnSALocsToCLocs ()), SOME {szb=sz, align=align}, 8)
259                    end
260                  | CTy.C_ARRAY (ty, len) => raise Fail "todo"
261                | _ => (SOME (returnSALocsToCLocs ()), NONE, 0)                | _ => (SOME (returnSALocsToCLocs ()), NONE, 0)
262               (* end case *))               (* end case *))
263          (* convert parameter locations for staged allocation to parameter locations for C *)          (* convert parameter locations for staged allocation to parameter locations for C *)
# Line 284  Line 295 
295              [T.FCOPY (mty, [r], [tmp]), T.FMV (mty, tmp, e)]              [T.FCOPY (mty, [r], [tmp]), T.FMV (mty, tmp, e)]
296          end          end
297    
298      fun copyLoc (arg, [loc], (stms, gprs, fprs)) = (case (arg, loc)      (* generate MLRISC statements for copying a C argument to a parameter / return location *)
299        fun copyLoc arg (i, loc, (stms, gprs, fprs)) = (case (arg, loc)
300           of (ARG (e as T.REG _), C_STK (mty, offset)) =>           of (ARG (e as T.REG _), C_STK (mty, offset)) =>
301              (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)              (T.STORE (wordTy, offSp offset, e, stack) :: stms, gprs, fprs)
302              | (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty1, r1)) =>
303                (copyToReg(mty1, r1, T.LOAD (ty, T.ADD(wordTy, e, li (i*8)), rgn)) @ stms, gprs, fprs)
304              | (ARG (T.LOAD (ty, e, rgn)), C_STK (mty, offset)) => let
305                val tmp = C.newReg ()
306                in
307                    (T.STORE (wordTy, offSp offset, T.REG (wordTy, tmp), stack) ::
308                     T.MV (wordTy, tmp, T.LOAD (ty, T.ADD(wordTy, e, li (i*8)), rgn)) :: stms, gprs, fprs)
309                end
310            | (ARG e, C_STK (mty, offset)) => let            | (ARG e, C_STK (mty, offset)) => let
311               val tmp = C.newReg ()               val tmp = C.newReg ()
312               in               in
313                  (T.STORE (mty, offSp offset, T.REG (mty, tmp), stack) ::T.MV (mty, tmp, e) :: stms, gprs, fprs)                  (T.STORE (wordTy, offSp offset, T.REG (wordTy, tmp), stack) ::T.MV (wordTy, tmp, e) :: stms, gprs, fprs)
314                end                end
315            | (ARG e, C_GPR (mty, r)) => (copyToReg(mty, r, e) @ stms, r :: gprs, fprs)            | (ARG e, C_GPR (mty, r)) => (copyToReg(mty, r, e) @ stms, r :: gprs, fprs)
316            | (FARG (e as T.FREG _), C_STK (mty, offset)) =>            | (FARG (e as T.FREG _), C_STK (mty, offset)) =>
317              (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)              (T.FSTORE (mty, offSp offset, e, stack) :: stms, gprs, fprs)
318              | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty1, r1)) =>
319                (copyToFReg(mty1, r1, T.FLOAD (ty, T.ADD(wordTy, e, li (i*8)), rgn)) @ stms, gprs, fprs)
320              | (FARG (T.FLOAD (ty, e, rgn)), C_STK (mty, offset)) => let
321                val tmp = C.newFreg ()
322                in
323                    (T.FSTORE (wordTy, offSp offset, T.FREG (wordTy, tmp), stack) ::
324                     T.FMV (wordTy, tmp, T.FLOAD (ty, T.ADD(wordTy, e, li (i*8)), rgn)) :: stms, gprs, fprs)
325                end
326            | (FARG e, C_STK (mty, offset)) => let            | (FARG e, C_STK (mty, offset)) => let
327              val tmp = C.newFreg ()              val tmp = C.newFreg ()
328              in              in
329                  (T.FSTORE (mty, offSp offset, T.FREG (mty, tmp), stack) :: T.FMV (mty, tmp, e) :: stms, gprs, fprs)                  (T.FSTORE (wordTy, offSp offset, T.FREG (wordTy, tmp), stack) :: T.FMV (wordTy, tmp, e) :: stms, gprs, fprs)
330              end              end
331            | (FARG e, C_FPR (mty, r)) => (copyToFReg(mty, r, e) @ stms, gprs, (mty, r) :: fprs)            | (FARG e, C_FPR (mty, r)) => (copyToFReg(mty, r, e) @ stms, gprs, (mty, r) :: fprs)
332            | _ => raise Fail "invalid arg / location combination"            | _ => raise Fail "invalid arg / location combination"
333           (* end case *))           (* end case *))
334    
335        fun copyLocs (arg, locs, (stms, gprs, fprs)) =
336            ListPair.foldl (copyLoc arg) (stms, gprs, fprs) (List.tabulate(List.length locs, fn i => i), locs)
337    (*
338        | copyLoc (arg, [loc1, loc2], (stms, gprs, fprs)) = (case (arg, loc1, loc2)        | copyLoc (arg, [loc1, loc2], (stms, gprs, fprs)) = (case (arg, loc1, loc2)
339           of (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty1, r1), C_GPR (mty2, r2)) =>           of (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty1, r1), C_GPR (mty2, r2)) =>
340              (List.concat [ copyToReg(mty1, r1, T.LOAD (ty, e, rgn)),              (List.concat [ copyToReg(mty1, r1, T.LOAD (ty, e, rgn)),
341                             copyToReg(mty2, r2, T.LOAD (ty, T.MULS(wordTy, e, li 8), rgn)),                             copyToReg(mty2, r2, T.LOAD (ty, T.ADD(wordTy, e, li 8), rgn)),
342                             stms],                             stms],
343               gprs, fprs)               gprs, fprs)
344            | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty1, r1), C_FPR (mty2, r2)) =>            | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty1, r1), C_FPR (mty2, r2)) =>
345              (List.concat [ copyToFReg(mty1, r1, T.FLOAD (ty, e, rgn)),              (List.concat [ copyToFReg(mty1, r1, T.FLOAD (ty, e, rgn)),
346                             copyToFReg(mty2, r2, T.FLOAD (ty, T.MULS(wordTy, e, li 8), rgn)),                             copyToFReg(mty2, r2, T.FLOAD (ty, T.ADD(wordTy, e, li 8), rgn)),
347                             stms],                             stms],
348               gprs, fprs)               gprs, fprs)
349            | (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty1, r1), C_FPR (mty2, r2)) =>            | (ARG (T.LOAD (ty, e, rgn)), C_GPR (mty1, r1), C_FPR (mty2, r2)) =>
350              (List.concat [ copyToReg(mty1, r1, T.LOAD (ty, e, rgn)),              (List.concat [ copyToReg(mty1, r1, T.LOAD (ty, e, rgn)),
351                             copyToFReg(mty2, r2, T.FLOAD (ty, T.MULS(wordTy, e, li 8), rgn)),                             copyToFReg(mty2, r2, T.FLOAD (ty, T.ADD(wordTy, e, li 8), rgn)),
352                             stms],                             stms],
353               gprs, fprs)               gprs, fprs)
354            | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty1, r1), C_GPR (mty2, r2)) =>            | (ARG (T.LOAD (ty, e, rgn)), C_FPR (mty1, r1), C_GPR (mty2, r2)) =>
355              (List.concat [ copyToFReg(mty1, r1, T.FLOAD (ty, e, rgn)),              (List.concat [ copyToFReg(mty1, r1, T.FLOAD (ty, e, rgn)),
356                             copyToReg(mty2, r2, T.LOAD (ty, T.MULS(wordTy, e, li 8), rgn)),                             copyToReg(mty2, r2, T.LOAD (ty, T.ADD(wordTy, e, li 8), rgn)),
357                             stms],                             stms],
358               gprs, fprs)               gprs, fprs)
359            | _ => raise Fail "invalid arg / location combination"            | _ => raise Fail "invalid arg / location combination"
360           (* end case *))           (* end case *))
361    *)
362    
363      (* copy C arguments into parameter locations *)      (* copy C arguments into parameter locations *)
364      fun copyArgs (args, argLocs) = ListPair.foldl copyLoc ([], [], []) (args, argLocs)      fun copyArgs (args, argLocs) = let
365            val (stms, gprs, fprs) = ListPair.foldl copyLocs ([], [], []) (args, argLocs)
366            in
367                (List.rev stms, gprs, fprs)
368            end
369    
370      (* copy the return value into the result location *)      (* copy the return value into the result location *)
371      fun returnVals resLoc = (case resLoc      fun returnVals resLoc = (case resLoc
# Line 383  Line 420 
420        val ty8 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int],CTy.C_float,CTy.C_float]]        val ty8 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int],CTy.C_float,CTy.C_float]]
421        val ty9 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]        val ty9 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]
422        val ty10 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float, CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int]]]        val ty10 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float, CTy.C_STRUCT[CTy.C_float,CTy.C_unsigned CTy.I_int]]]
423          val ty11 = CTy.C_STRUCT [CTy.C_PTR, CTy.C_float, CTy.C_float, CTy.C_float]
424    
425        fun ebTest () = let        fun ebTest () = let
426          fun test (ty, len) =          fun test (ty, len) =
427              if List.length (eightBytes (flattenCTy ty)) <> len              if List.length (eightBytes (CTypes.flattenCTy ty)) <> len
428                 then raise Fail "failed test"                 then raise Fail "failed test"
429                 else ()                 else ()
430          in          in
# Line 395  Line 433 
433    
434        fun kindOfEB () = let        fun kindOfEB () = let
435            fun test (eb, k) = (kindOfEightByte eb = k) orelse raise Fail "failed test"            fun test (eb, k) = (kindOfEightByte eb = k) orelse raise Fail "failed test"
436            fun eb1 ty = hd (eightBytes (flattenCTy ty))            fun eb1 ty = hd (eightBytes (CTypes.flattenCTy ty))
437            fun eb2 ty = hd(tl (eightBytes (flattenCTy ty)))            fun eb2 ty = hd(tl (eightBytes (CTypes.flattenCTy ty)))
438            in            in
439                List.all test [(eb1 ty1, K_GPR), (eb1 ty2, K_GPR), (eb2 ty3, K_GPR),                List.all test [(eb1 ty1, K_GPR), (eb1 ty2, K_GPR), (eb2 ty3, K_GPR),
440                               (eb1 ty5, K_FPR), (eb1 ty6, K_FPR), (eb2 ty6, K_FPR),                               (eb1 ty5, K_FPR), (eb1 ty6, K_FPR), (eb2 ty6, K_FPR),
# Line 415  Line 453 
453            val tests = [(ty2, [K_GPR]), (ty1, [K_GPR]), (ty3, [K_GPR, K_GPR]), (ty4, [K_GPR, K_GPR]),            val tests = [(ty2, [K_GPR]), (ty1, [K_GPR]), (ty3, [K_GPR, K_GPR]), (ty4, [K_GPR, K_GPR]),
454                         (ty5, [K_FPR]), (ty6, [K_FPR, K_FPR]),                         (ty5, [K_FPR]), (ty6, [K_FPR, K_FPR]),
455                         (ty7, [K_FPR, K_FPR]), (ty8, [K_GPR, K_FPR]),                         (ty7, [K_FPR, K_FPR]), (ty8, [K_GPR, K_FPR]),
456                         (ty9, [K_MEM]), (ty10, [K_FPR, K_GPR])                         (ty9, [K_MEM]), (ty10, [K_FPR, K_GPR]),
457                           (ty11, [K_MEM])
458                                         ]                                         ]
459            val (ts, anss) = ListPair.unzip tests            val (ts, anss) = ListPair.unzip tests
460            in            in
461               ListPair.all test (List.map cTyToLocs ts, anss) orelse raise Fail "failed test"               ListPair.all test (List.map cTyToLocs ts, anss) orelse raise Fail "failed test"
462            end            end
463    
464        fun paramTyEx () = layout {conv="ccall", retTy=CTy.C_void, paramTys=[ty5]}        val proto1 = {conv="ccall", retTy=CTy.C_void, paramTys=[ty11]}
465          fun paramTyEx () = layout proto1
466          fun argEx () = genCall {name=T.LOAD(32, li 1024, mem), proto=proto1, paramAlloc=fn _ => false,
467                                  structRet=fn _ => raise Fail "",
468                                  saveRestoreDedicated=fn _ => raise Fail "",
469                                  callComment=NONE, args=[ARG (T.LOAD(32, li 0, mem))]}
470    
471      end      end
472    

Legend:
Removed from v.2994  
changed lines
  Added in v.2995

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