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 3049, Fri May 30 00:58:55 2008 UTC revision 3055, Tue Jun 3 06:55:14 2008 UTC
# Line 10  Line 10 
10  functor VarargCCallFn (  functor VarargCCallFn (
11      structure T : MLTREE      structure T : MLTREE
12      structure CCall : C_CALL where T = T      structure CCall : C_CALL where T = T
13      (* registers for passing parameters *)
14      val gprParams : T.reg list      val gprParams : T.reg list
15      val fprParams : T.reg list      val fprParams : T.reg list
16      (* possible widths for passing parameters *)
17        val gprTys : T.ty list
18        val fprTys : T.ty list
19      (* stack pointer register *)
20      val spReg : T.rexp      val spReg : T.rexp
21      (* default register width *)
22      val wordTy : T.ty      val wordTy : T.ty
23      val newReg : 'a -> CellsBasis.cell      val newReg : 'a -> CellsBasis.cell
24    ) = struct    ) = struct
# Line 23  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 argToCTy (I _) = CTy.C_signed CTy.I_int      fun concatMap f xs = List.concat (List.map f xs)
       | argToCTy (R _) = CTy.C_double  
       | argToCTy (B _) = CTy.C_signed CTy.I_int  
       | argToCTy (S _) = CTy.C_PTR  
33    
     val wordSzB = wordTy div 8  
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
37    
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 *)
44      val GPR = 0      val GPR = 0
45      val FPR = 1      val FPR = 1
46      val STK = 2      val STK = 2
47        val FSTK = 3
48    
49      val intTy = wordTy    (* offsets into the zipped argument *)
   
   (* offsets into the triplet *)  
50      val argOff = 0      val argOff = 0
51      val kindOff = 1      val kindOff = 1
52      val locOff = 2      val locOff = 2
53        val tyOff = 3
54    
55      fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)    (* load a value from the zipped argument *)
56      fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)      fun offZippedArg (ty, arg, off) = T.LOAD(ty, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
57    
58      val regToInt = CB.physicalRegisterNum    (* load a floating-point value from the zipped argument *)
59      fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))      fun offZippedArgF (ty, arg, off) = T.FLOAD(ty, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
60      val labelOfStk = Label.global "stk"  
61      val interpLab = Label.global "interp"      fun newLabel s = Label.label s ()
62      fun chooseRegsLab k = Label.global ("chooseRegs"^k)  
63      val chooseStkLab = Label.global "chooseStk"      fun labelOfReg (k, ty, r) =
64      val chooseKindsLab = Label.global "chooseKinds"              Label.global (k^Int.toString ty^"."^Int.toString (regToInt r)^".reg")
65    
66        local
67          fun atTyLab (k, tys) = List.map (fn ty => (ty, newLabel (k^Int.toString ty^"."))) tys
68          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
75                            of "gpr" => gprLabs
76                             | "fpr" => fprLabs
77                             | "stk" => stkLabs
78                             | "fstk" => fstkLabs
79                          (* end case *))
80               val SOME (_, lab) = List.find (fn (ty', _) => ty = ty') labs
81               in
82                  lab
83               end
84        end
85    
86        local
87          fun atKindLab k = (k, newLabel ("resolveTys."^k))
88          val labs = List.map atKindLab ["gpr", "fpr", "stk", "fstk"]
89        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 interpLab = newLabel "interp"
98        val resolveKindsLab = newLabel "resolveKinds"
99        val gotoCLab = newLabel "gotoC"
100    
101      (* store a gpr argument on the stack *)
102        fun storeStk (arg, ty) =
103                T.STORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArg(ty, arg, argOff), mem)
104    
105        fun genStoreStkAtTy arg ty = [
106               T.DEFINE (resolveAtKindAndTyLab ("stk", ty)),
107               storeStk(arg, ty),
108               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 *)
115        fun storeFStk (arg, ty) =
116                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 genStoreStk arg = [      fun genStoreFStkAtTy arg ty = [
120             T.DEFINE chooseStkLab,             T.DEFINE (resolveAtKindAndTyLab ("fstk", ty)),
121             T.STORE(wordTy, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),             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 r = [      fun genPutGpr arg ty r = [
130             T.DEFINE (labelOfReg ("gpr", r)),             T.DEFINE (labelOfReg ("gpr", ty, r)),
131             T.MV (intTy, r, offTrip (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 r = [      fun genPutFpr arg ty r = [
137             T.DEFINE (labelOfReg ("fpr", r)),             T.DEFINE (labelOfReg ("fpr", ty, r)),
138             T.FMV (64, r, offTripF (arg, argOff)),             T.FMV (ty, r, offZippedArgF (ty, arg, argOff)),
139             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
140          ]          ]
141    
142    (* choose the function for loading the register *)    (* resolve the function for loading the register *)
143      fun genChooseReg arg k (r, instrs) = let      fun genResolveReg arg k ty (r, instrs) = let
144             val cmp = T.CMP(wordTy, T.EQ, offTrip(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    (* choose registers for loading function arguments *)    (* check the type of the argument *)
150      fun genChooseRegs arg k regs = let      fun checkTy arg k ty =
151             val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)              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 *)
158        fun genResolveTys arg =
159                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 *)
167        fun genResolveRegs arg k tys regs = let
168                val resolves = List.map (genResolveRegsOfTy arg k) tys
169             in             in
170                T.DEFINE (chooseRegsLab k) :: instrs                 concatMap (fn f => f regs) resolves
171             end             end
172    
173    (* choose the kind of argument *)    (* resolve an argument to a kind of location *)
174      fun genChooseKinds arg = [      fun resolveKind arg (kEncoding, k) =
175             T.DEFINE chooseKindsLab,              T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit kEncoding), resolveTysLab k)
176             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),  
177             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),    (* resolve the argument to one of the location kinds *)
178             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab)      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 *)
190      val NIL = 0      val NIL = 0
191    
192      (* load a value from the argument *)
193      fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)      fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)
194        | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*8)), mem)        | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*wordSzB)), mem)
   
     val gotoCLab = Label.label "gotoC" ()  
195    
196    (* call the varargs C function *)    (* call the varargs C function *)
197      fun genCallC cFun = let      fun genCallC cFun = let
# Line 126  Line 211 
211             T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),             T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),
212             T.MV (wordTy, argReg, offArgs args 0),             T.MV (wordTy, argReg, offArgs args 0),
213             T.MV(wordTy, args, offArgs args 1),             T.MV(wordTy, args, offArgs args 1),
214             T.JMP (T.LABEL chooseKindsLab, [])             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 ()
            val interpInstrs = genInterp(args, argReg)  
232             val arg = T.REG(wordTy, argReg)             val arg = T.REG(wordTy, argReg)
            val ckInstrs = genChooseKinds arg  
            val chooseGprs = genChooseRegs arg "gpr" gprParams  
            val chooseFprs = genChooseRegs arg "fpr" fprParams  
            val loadGprs = List.concat (List.map (genPutGpr arg) gprParams)  
            val loadFprs = List.concat (List.map (genPutFpr arg) fprParams)  
            val storeStk = genStoreStk arg  
233             in             in
234                List.concat [                List.concat [
235                   interpInstrs,                   genInterp(args, argReg),
236                   ckInstrs,                   genResolveKinds arg,
237                   chooseGprs,                   resolveArgLocs arg,
238                   chooseFprs,                   genResolveTys arg,
239                   loadGprs,                   genPutGprs arg,
240                   loadFprs,                   genPutFprs arg,
                  storeStk,  
241                   genCallC cFun                   genCallC cFun
242                ]                ]
243             end             end
244    
245        fun argToCTy (I _) = CTy.C_signed CTy.I_int
246          | argToCTy (R _) = CTy.C_double
247          | argToCTy (B _) = CTy.C_signed CTy.I_int
248          | argToCTy (S _) = CTy.C_PTR
249    
250      (* runtime friendly representation of the C location *)
251        fun encodeCLoc (CCall.C_GPR (ty, r)) = (GPR, regToInt r, ty)
252          | encodeCLoc (CCall.C_FPR (ty, r)) = (FPR, regToInt r, ty)
253          | encodeCLoc (CCall.C_STK (ty, off)) = (STK, T.I.toInt (wordTy, off), ty)
254          | encodeCLoc (CCall.C_FSTK (ty, off)) = (FSTK, T.I.toInt (wordTy, off), ty)
255    
256      (* takes a vararg and a location and returns the vararg triplet *)
257        fun varArg (arg, loc) = let
258               val (k, l, ty) = encodeCLoc loc
259               in
260                 (arg, k, l, ty)
261               end
262    
263       (* package the arguments with their locations *)
264        fun encodeArgs args = let
265                val argTys = List.map argToCTy args
266                val {argLocs, argMem, ...} = CCall.layout {conv="c-call", retTy=CTy.C_void, paramTys=argTys}
267              (* expect single locations, as we do not pass aggregates to vararg functions *)
268                val argLocs = List.map List.hd argLocs
269                in
270                    (ListPair.mapEq varArg (args, List.rev argLocs), argMem)
271                end
272    
273    end (* AMD64VarargCCallFn *)    end (* VarargCCallFn *)

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

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