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/staged-allocation/vararg-c-call-fn.sml
ViewVC logotype

Diff of /MLRISC/trunk/staged-allocation/vararg-c-call-fn.sml

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

revision 3054, Tue Jun 3 01:26:28 2008 UTC revision 3055, Tue Jun 3 06:55:14 2008 UTC
# Line 29  Line 29 
29    
30      datatype argument = I of int | R of real | B of bool | S of string      datatype argument = I of int | R of real | B of bool | S of string
31    
32        fun concatMap f xs = List.concat (List.map f xs)
33    
34      val mem = T.Region.memory      val mem = T.Region.memory
35      val stack = T.Region.stack      val stack = T.Region.stack
36      val wordSzB = wordTy div 8      val wordSzB = wordTy div 8
# Line 36  Line 38 
38      fun lit i = T.LI (T.I.fromInt (wordTy, i))      fun lit i = T.LI (T.I.fromInt (wordTy, i))
39      fun gpr r = T.GPR (T.REG (wordTy, r))      fun gpr r = T.GPR (T.REG (wordTy, r))
40      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
41        val regToInt = CB.physicalRegisterNum
42    
43    (* encodings for the kinds of argument locations *)    (* encodings for the kinds of argument locations *)
44      val GPR = 0      val GPR = 0
# Line 57  Line 60 
60    
61      fun newLabel s = Label.label s ()      fun newLabel s = Label.label s ()
62    
63      val regToInt = CB.physicalRegisterNum      fun labelOfReg (k, ty, r) =
64      fun labelOfReg (k, r) = newLabel ("put"^k^Int.toString (regToInt r))              Label.global (k^Int.toString ty^"."^Int.toString (regToInt r)^".reg")
     val labelOfStk = newLabel "stk"  
     val interpLab = newLabel "interp"  
   
     val storeAtTyLabs = List.map (fn ty => (ty, newLabel ("storeAtTy"^Int.toString ty))) gprTys  
     val resolveTysLab = newLabel "resolveTys"  
65    
66      val resolveGprsAtTyLab = List.map (fn ty => (ty, newLabel ("resolveGprs"^Int.toString ty))) gprTys      local
67      val resolveFprsAtTyLab = List.map (fn ty => (ty, newLabel ("resolveFprs"^Int.toString ty))) fprTys        fun atTyLab (k, tys) = List.map (fn ty => (ty, newLabel (k^Int.toString ty^"."))) tys
68      fun resolveRegsAtTyLab (ty, k) = let        val gprLabs = atTyLab ("resolveGprs", gprTys)
69          val fprLabs = atTyLab ("resolveFprs", fprTys)
70          val stkLabs = atTyLab ("resolveStk", gprTys)
71          val fstkLabs = atTyLab ("resolveFstk", fprTys)
72        in
73        fun resolveAtKindAndTyLab (k, ty) = let
74             val labs = (case k             val labs = (case k
75                          of "gpr" => resolveGprsAtTyLab                          of "gpr" => gprLabs
76                           | "fpr" => resolveFprsAtTyLab                           | "fpr" => fprLabs
77                             | "stk" => stkLabs
78                             | "fstk" => fstkLabs
79                        (* end case *))                        (* end case *))
80             val SOME (_, lab) = List.find (fn (ty', _) => ty = ty') labs             val SOME (_, lab) = List.find (fn (ty', _) => ty = ty') labs
81             in             in
82                lab                lab
83             end             end
84        end
85    
86      val resolveGprsLab = newLabel "resolveGprs"      local
87      val resolveFprsLab = newLabel "resolveFprs"        fun atKindLab k = (k, newLabel ("resolveTys."^k))
88      fun resolveRegsLab "gpr" = resolveGprsLab        val labs = List.map atKindLab ["gpr", "fpr", "stk", "fstk"]
89        | resolveRegsLab "fpr" = resolveFprsLab      in
90        fun resolveTysLab k = let
91                val SOME (_, lab) = List.find (fn (k', _) => k' = k) labs
92                in
93                    lab
94                end
95        end
96    
97      val resolveStkLab = newLabel "resolveStk"      val interpLab = newLabel "interp"
     val resolveFStkLab = newLabel "resolveFStk"  
98      val resolveKindsLab = newLabel "resolveKinds"      val resolveKindsLab = newLabel "resolveKinds"
99      val gotoCLab = newLabel "gotoC"      val gotoCLab = newLabel "gotoC"
100    
# Line 91  Line 102 
102      fun storeStk (arg, ty) =      fun storeStk (arg, ty) =
103              T.STORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArg(ty, arg, argOff), mem)              T.STORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArg(ty, arg, argOff), mem)
104    
105    (* store the argument at the stack offset *)      fun genStoreStkAtTy arg ty = [
106      fun genStoreStk arg ty = [             T.DEFINE (resolveAtKindAndTyLab ("stk", ty)),
            T.DEFINE resolveStkLab,  
107             storeStk(arg, ty),             storeStk(arg, ty),
108             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
109          ]          ]
110    
111      (* store the argument at the stack offset *)
112        fun genStoreStk arg tys = concatMap (genStoreStkAtTy arg) tys
113    
114    (* store a fpr argument on the stack *)    (* store a fpr argument on the stack *)
115      fun storeFStk (arg, ty) =      fun storeFStk (arg, ty) =
116              T.FSTORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArgF(ty, arg, argOff), mem)              T.FSTORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArgF(ty, arg, argOff), mem)
117    
118    (* store the argument at the stack offset *)    (* store the argument at the stack offset *)
119      fun genStoreFStk arg ty = [      fun genStoreFStkAtTy arg ty = [
120             T.DEFINE resolveFStkLab,             T.DEFINE (resolveAtKindAndTyLab ("fstk", ty)),
121             storeFStk (arg, ty),             storeFStk (arg, ty),
122             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
123          ]          ]
124    
125      (* store the argument at the stack offset *)
126        fun genStoreFStk arg tys = concatMap (genStoreFStkAtTy arg) tys
127    
128    (* place the argument into the parameter register and jump back to the interpreter *)    (* place the argument into the parameter register and jump back to the interpreter *)
129      fun genPutGpr arg ty r = [      fun genPutGpr arg ty r = [
130             T.DEFINE (labelOfReg ("gpr", r)),             T.DEFINE (labelOfReg ("gpr", ty, r)),
131             T.MV (ty, r, offZippedArg (ty, arg, argOff)),             T.MV (ty, r, offZippedArg (ty, arg, argOff)),
132             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
133          ]          ]
134    
135    (* place the argument into the parameter register and jump back to the interpreter *)    (* place the argument into the parameter register and jump back to the interpreter *)
136      fun genPutFpr arg ty r = [      fun genPutFpr arg ty r = [
137             T.DEFINE (labelOfReg ("fpr", r)),             T.DEFINE (labelOfReg ("fpr", ty, r)),
138             T.FMV (ty, r, offZippedArgF (ty, arg, argOff)),             T.FMV (ty, r, offZippedArgF (ty, arg, argOff)),
139             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
140          ]          ]
141    
142    (* resolve the function for loading the register *)    (* resolve the function for loading the register *)
143      fun genResolveReg arg k (r, instrs) = let      fun genResolveReg arg k ty (r, instrs) = let
144             val cmp = T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, locOff), lit (regToInt r))             val cmp = T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, locOff), lit (regToInt r))
145             in             in
146                T.BCC(cmp, labelOfReg (k, r)) :: instrs                T.BCC(cmp, labelOfReg (k, ty, r)) :: instrs
147             end             end
148    
149    (* check the type of the argument *)    (* check the type of the argument *)
150      fun checkTy arg (ty, resolveTyLab) =      fun checkTy arg k ty =
151              T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, tyOff), lit ty), resolveTyLab)              T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, tyOff), lit ty), resolveAtKindAndTyLab(k, ty))
152    
153      (* resolve the type of the argument at a given kind *)
154        fun genResolveTysAtKind arg (k, tys) =
155             T.DEFINE (resolveTysLab k) :: List.map (checkTy arg k) tys
156    
157    (* resolve the type of the argument *)    (* resolve the type of the argument *)
158      fun genResolveTys arg =      fun genResolveTys arg =
159           T.DEFINE resolveTysLab :: List.map (checkTy arg) storeAtTyLabs              concatMap (genResolveTysAtKind arg) [("gpr", gprTys), ("fpr", fprTys), ("stk", gprTys), ("fstk", fprTys)]
160    
161      (* resolve registers at a fixed type *)
162        fun genResolveRegsOfTy arg k ty regs =
163                T.DEFINE (resolveAtKindAndTyLab (k, ty)) ::
164                List.rev (T.JMP(T.LABEL interpLab, []) :: List.foldl (genResolveReg arg k ty) [] regs)
165    
166    (* resolve registers for loading function arguments *)    (* resolve registers for loading function arguments *)
167      fun genResolveRegs arg k regs =      fun genResolveRegs arg k tys regs = let
168              T.DEFINE (resolveRegsLab k) ::              val resolves = List.map (genResolveRegsOfTy arg k) tys
169              List.rev (T.JMP(T.LABEL interpLab, []) :: List.foldl (genResolveReg arg k) [] regs)              in
170                   concatMap (fn f => f regs) resolves
171    (* resolve the kind of argument *)              end
172      fun genResolveKinds arg = [  
173             T.DEFINE resolveKindsLab,    (* resolve an argument to a kind of location *)
174             T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit GPR), resolveRegsLab "gpr"),      fun resolveKind arg (kEncoding, k) =
175             T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit FPR), resolveRegsLab "fpr"),              T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit kEncoding), resolveTysLab k)
176             T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit STK), resolveStkLab),  
177             T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit FSTK), resolveFStkLab)    (* resolve the argument to one of the location kinds *)
178        fun genResolveKinds arg =
179               T.DEFINE resolveKindsLab ::
180               List.map (resolveKind arg) [(GPR, "gpr"), (FPR, "fpr"), (STK, "stk"), (FSTK, "fstk")]
181    
182        fun resolveArgLocs arg = List.concat [
183               genResolveRegs arg "gpr" gprTys gprParams,
184               genResolveRegs arg "fpr" fprTys fprParams,
185               genStoreStk arg gprTys,
186               genStoreFStk arg fprTys
187          ]          ]
188    
189    (* end of the argument list *)    (* end of the argument list *)
# Line 180  Line 214 
214             T.JMP (T.LABEL resolveKindsLab, [])             T.JMP (T.LABEL resolveKindsLab, [])
215          ]          ]
216    
217        fun genPutGprs arg = let
218                val putGprs = List.map (genPutGpr arg) gprTys
219                in
220                   concatMap (fn f => concatMap f gprParams) putGprs
221                end
222    
223        fun genPutFprs arg = let
224                val putfprs = List.map (genPutFpr arg) fprTys
225                in
226                   concatMap (fn f => concatMap f fprParams) putfprs
227                end
228    
229    (* generate instructions for making a varargs call *)    (* generate instructions for making a varargs call *)
230      fun genVarargs (cFun, args) = let      fun genVarargs (cFun, args) = let
231             val argReg = newReg ()             val argReg = newReg ()
232             val arg = T.REG(wordTy, argReg)             val arg = T.REG(wordTy, argReg)
            val resolveGprs = genResolveRegs arg "gpr" gprParams  
            val resolveFprs = genResolveRegs arg "fpr" fprParams  
 (* FIXME *)  
            val loadGprs = List.concat (List.map (genPutGpr arg wordTy) gprParams)  
            val loadFprs = List.concat (List.map (genPutFpr arg 64) fprParams)  
233             in             in
234                List.concat [                List.concat [
235                   genInterp(args, argReg),                   genInterp(args, argReg),
236                   genResolveKinds arg,                   genResolveKinds arg,
237                   loadGprs,                   resolveArgLocs arg,
238                   loadFprs,                   genResolveTys arg,
239                   resolveGprs,                   genPutGprs arg,
240                   resolveFprs,                   genPutFprs arg,
 (* FIXME *)  
                  genStoreStk arg wordTy,  
                  genStoreFStk arg 64,  
241                   genCallC cFun                   genCallC cFun
242                ]                ]
243             end             end
244    
     val regToInt = CB.physicalRegisterNum  
   
245      fun argToCTy (I _) = CTy.C_signed CTy.I_int      fun argToCTy (I _) = CTy.C_signed CTy.I_int
246        | argToCTy (R _) = CTy.C_double        | argToCTy (R _) = CTy.C_double
247        | argToCTy (B _) = CTy.C_signed CTy.I_int        | argToCTy (B _) = CTy.C_signed CTy.I_int

Legend:
Removed from v.3054  
changed lines
  Added in v.3055

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