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-fn.sml
ViewVC logotype

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

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

revision 3037, Tue May 27 06:30:07 2008 UTC revision 3038, Tue May 27 23:48:15 2008 UTC
# Line 24  Line 24 
24      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
25      fun sum ls = List.foldl (op +) 0 ls      fun sum ls = List.foldl (op +) 0 ls
26      fun szBOfCTy cTy = #sz (CSizes.sizeOfTy cTy)      fun szBOfCTy cTy = #sz (CSizes.sizeOfTy cTy)
27        fun alignBOfCTy cTy = #align (CSizes.sizeOfTy cTy)
28    
29      fun toGpr r = (wordTy, r)      fun toGpr r = (wordTy, r)
30      fun toGprs gprs = List.map toGpr gprs      fun toGprs gprs = List.map toGpr gprs
# Line 57  Line 58 
58        (* conventions for returning arguments *)        (* conventions for returning arguments *)
59          val gprRets = toGprs [C.rax, C.rdx]          val gprRets = toGprs [C.rax, C.rdx]
60          val fprRets = toFprs [C.xmm0, C.xmm1]          val fprRets = toFprs [C.xmm0, C.xmm1]
61          val (_, ssFloat) = SA.useRegs fprRets          val (cRetFpr, ssFloat) = SA.useRegs fprRets
62          val (_, ssGpr) = SA.useRegs gprRets          val (cRetGpr, ssGpr) = SA.useRegs gprRets
63          val cCallStk = SA.freshCounter ()          val cCallStk = SA.freshCounter ()
64          val returnStages = [          val returnStages = [
65              SA.CHOICE [              SA.CHOICE [
# Line 80  Line 81 
81          val cCallGpr = SA.freshCounter ()          val cCallGpr = SA.freshCounter ()
82          val cCallFpr = SA.freshCounter ()          val cCallFpr = SA.freshCounter ()
83        (* initial store *)        (* initial store *)
84          val str0 = SA.init [cCallStk, cCallGpr, cCallFpr]          val str0 = SA.init [cCallStk, cCallGpr, cCallFpr, cRetFpr, cRetGpr]
85    
86          val callStages = [          val callStages = [
87                SA.CHOICE [                SA.CHOICE [
# Line 113  Line 114 
114      datatype c_arg = datatype CCall.c_arg      datatype c_arg = datatype CCall.c_arg
115    
116    (* convert a list of C types to a list of eight bytes *)    (* convert a list of C types to a list of eight bytes *)
117      fun eightBytesOfCTys ([], eb, ebs) = List.rev (List.map List.rev (eb :: ebs))      fun eightBytesOfCTys ([], [], ebs) = List.rev (List.map List.rev ebs)
118          | eightBytesOfCTys ([], eb, ebs) = List.rev (List.map List.rev (eb :: ebs))
119        | eightBytesOfCTys (cTy :: cTys, eb, ebs) = let        | eightBytesOfCTys (cTy :: cTys, eb, ebs) = let
120              val szTy = szBOfCTy cTy              val szTy = szBOfCTy cTy
121              val szEb = sum(List.map szBOfCTy eb)              val szEb = sum(List.map szBOfCTy eb)
# Line 130  Line 132 
132    
133    (* classify a C type into its location kind (assuming that aggregates cannot be passed in registers) *)    (* classify a C type into its location kind (assuming that aggregates cannot be passed in registers) *)
134      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
135        | kindOfCTy (CTy.C_ARRAY _) = K_MEM        | kindOfCTy (CTy.C_ARRAY _ | CTy.C_STRUCT _ | CTy.C_UNION _) = raise Fail "impossible"
       | kindOfCTy (CTy.C_STRUCT _ | CTy.C_UNION _) = raise Fail "impossible"  
136        | kindOfCTy (CTy.C_unsigned _ | CTy.C_signed _ | CTy.C_PTR) = K_GPR        | kindOfCTy (CTy.C_unsigned _ | CTy.C_signed _ | CTy.C_PTR) = K_GPR
137    
138      fun combineKinds (k1, k2) = if (k1 = k2)      fun combineKinds (k1, k2) = if (k1 = k2)
# Line 156  Line 157 
157             end             end
158    
159      fun containsUnalignedFields cTy = (case cTy      fun containsUnalignedFields cTy = (case cTy
160          of (CTy.C_STRUCT cTys | CTy.C_UNION cTys) =>          of (CTy.C_STRUCT cTys | CTy.C_UNION cTys) => List.exists containsUnalignedFields cTys
161             List.all (fn cTy => #sz (CSizes.sizeOfTy cTy) mod 8 = 0) cTys           | cTy => Int.max(8, szBOfCTy cTy) mod 8 <> 0
162           | _ => false)          (* end case *))
163    
164    (* classify a C type into its location kinds *)      fun slotsOfCTy (cTy as (CTy.C_STRUCT _ | CTy.C_UNION _ | CTy.C_ARRAY _)) =
     fun kindsOfCTy (cTy as CTy.C_STRUCT cTys) =  
165             if (szBOfCTy cTy > 2*8 orelse containsUnalignedFields cTy)             if (szBOfCTy cTy > 2*8 orelse containsUnalignedFields cTy)
166                then List.tabulate (szBOfCTy cTy div 8, fn _ => K_MEM)                then List.tabulate (szBOfCTy cTy div 8, fn _ => (8*8, K_MEM, 8))
167                else List.map kindOfEightByte (eightBytesOfCTy cTy)                else List.map (fn eb => (8*8, kindOfEightByte eb, 8)) (eightBytesOfCTy cTy)
168        | kindsOfCTy (cTy as CTy.C_UNION cTys) = raise Fail "todo"        | slotsOfCTy cTy = [(8*szBOfCTy cTy, kindOfCTy cTy, alignBOfCTy cTy)]
       | kindsOfCTy (cTy as CTy.C_ARRAY _) = raise Fail "todo"  
       | kindsOfCTy cTy = [kindOfCTy cTy]  
   
     fun slotsOfCTy cTy = List.map (fn k => (8*8, k, 8)) (kindsOfCTy cTy)  
169    
170      fun slotOfCTy cTy = (case slotsOfCTy cTy      fun slotOfCTy cTy = (case slotsOfCTy cTy
171                            of [slot] => slot                            of [slot] => slot
# Line 257  Line 253 
253          val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult          val callSeq = argAlloc @ copyArgs @ [callStm] @ copyResult
254          in          in
255            {callseq=callSeq, result=resultRegs}            {callseq=callSeq, result=resultRegs}
         end (* genCall *)  
   
   
     (* unit testing code *)  
     structure Test = struct  
       val ty1 = CTy.C_STRUCT [CTy.C_STRUCT [CTy.C_unsigned CTy.I_char, CTy.C_unsigned CTy.I_int]]  
       val ty2 = CTy.C_STRUCT [CTy.C_signed CTy.I_short]  
       val ty3 = CTy.C_STRUCT [CTy.C_signed CTy.I_short, CTy.C_PTR]  
       val ty4 = CTy.C_STRUCT [CTy.C_PTR, CTy.C_PTR]  
       val ty4 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_unsigned CTy.I_int], CTy.C_PTR]  
       val ty5 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float]]  
       val ty6 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]  
       val ty7 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_STRUCT[CTy.C_float,CTy.C_float],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]]  
       val ty9 = CTy.C_STRUCT [CTy.C_STRUCT[CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float,CTy.C_float]]  
       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 ty11 = CTy.C_STRUCT [CTy.C_PTR, CTy.C_float, CTy.C_float, CTy.C_float]  
   
       fun kindOfEB () = let  
           fun test (eb, k) = (kindOfEightByte eb = k) orelse raise Fail "failed test"  
           fun eb1 ty = hd (eightBytesOfCTy ty)  
           fun eb2 ty = hd(tl (eightBytesOfCTy ty))  
           in  
               List.all test [(eb1 ty1, K_GPR), (eb1 ty2, K_GPR), (eb2 ty3, K_GPR),  
                              (eb1 ty5, K_FPR), (eb1 ty6, K_FPR), (eb2 ty6, K_FPR),  
                              (eb1 ty7, K_FPR), (eb2 ty7, K_FPR),  
                              (eb1 ty8, K_GPR), (eb2 ty8, K_FPR)]  
           end  
   
       fun li2k (_, k, _) = k  
   
       fun slots () = let  
           fun test (lis : SA.slot list, ks2 : location_kind list) = let  
               val ks1 = List.map li2k lis  
               in  
                  (List.length ks1 = List.length ks2) andalso (ListPair.all (op =) (ks1, ks2))  
               end  
           val tests = [  
 (*                     (ty2, [K_GPR]), (ty1, [K_GPR]), (ty3, [K_GPR, K_GPR]), (ty4, [K_GPR, K_GPR]),  
                        (ty5, [K_FPR]), (ty6, [K_FPR, K_FPR]),  
                        (ty7, [K_FPR, K_FPR]), (ty8, [K_GPR, K_FPR]),  
                        (ty9, [K_MEM]), (ty10, [K_FPR, K_GPR]),  
 *)  
                        (ty11, [K_MEM, K_MEM, K_MEM])  
                                        ]  
           val (ts, anss) = ListPair.unzip tests  
           in  
              ListPair.all test (List.map slotsOfCTy ts, anss) orelse raise Fail "failed test"  
           end  
256      end      end
257    
258    end (* AMD64SVIDFn *)    end (* AMD64SVIDFn *)

Legend:
Removed from v.3037  
changed lines
  Added in v.3038

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