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 3051, Fri May 30 06:29:06 2008 UTC revision 3054, Tue Jun 3 01:26:28 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 25  Line 31 
31    
32      val mem = T.Region.memory      val mem = T.Region.memory
33      val stack = T.Region.stack      val stack = T.Region.stack
34        val wordSzB = wordTy div 8
35    
36      fun lit i = T.LI (T.I.fromInt (wordTy, i))      fun lit i = T.LI (T.I.fromInt (wordTy, i))
37      fun gpr r = T.GPR (T.REG (wordTy, r))      fun gpr r = T.GPR (T.REG (wordTy, r))
38      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))      fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
39    
40      (* encodings for the kinds of argument locations *)
41      val GPR = 0      val GPR = 0
42      val FPR = 1      val FPR = 1
43      val STK = 2      val STK = 2
44      val FSTK = 3      val FSTK = 3
45    
46      val intTy = wordTy    (* offsets into the zipped argument *)
     val maxArgSzB = 8  
   
   (* offsets into the triplet *)  
47      val argOff = 0      val argOff = 0
48      val kindOff = 1      val kindOff = 1
49      val locOff = 2      val locOff = 2
50        val tyOff = 3
51    
52      (* load a value from the zipped argument *)
53        fun offZippedArg (ty, arg, off) = T.LOAD(ty, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
54    
55      fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*maxArgSzB)), mem)    (* load a floating-point value from the zipped argument *)
56      fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*maxArgSzB)), mem)      fun offZippedArgF (ty, arg, off) = T.FLOAD(ty, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
57    
58        fun newLabel s = Label.label s ()
59    
60      val regToInt = CB.physicalRegisterNum      val regToInt = CB.physicalRegisterNum
61      fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))      fun labelOfReg (k, r) = newLabel ("put"^k^Int.toString (regToInt r))
62      val labelOfStk = Label.global "stk"      val labelOfStk = newLabel "stk"
63      val interpLab = Label.global "interp"      val interpLab = newLabel "interp"
64      fun chooseRegsLab k = Label.global ("chooseRegs"^k)  
65      val chooseStkLab = Label.global "chooseStk"      val storeAtTyLabs = List.map (fn ty => (ty, newLabel ("storeAtTy"^Int.toString ty))) gprTys
66      val chooseFStkLab = Label.global "chooseFStk"      val resolveTysLab = newLabel "resolveTys"
67      val chooseKindsLab = Label.global "chooseKinds"  
68        val resolveGprsAtTyLab = List.map (fn ty => (ty, newLabel ("resolveGprs"^Int.toString ty))) gprTys
69        val resolveFprsAtTyLab = List.map (fn ty => (ty, newLabel ("resolveFprs"^Int.toString ty))) fprTys
70        fun resolveRegsAtTyLab (ty, k) = let
71               val labs = (case k
72                            of "gpr" => resolveGprsAtTyLab
73                             | "fpr" => resolveFprsAtTyLab
74                          (* end case *))
75               val SOME (_, lab) = List.find (fn (ty', _) => ty = ty') labs
76               in
77                  lab
78               end
79    
80        val resolveGprsLab = newLabel "resolveGprs"
81        val resolveFprsLab = newLabel "resolveFprs"
82        fun resolveRegsLab "gpr" = resolveGprsLab
83          | resolveRegsLab "fpr" = resolveFprsLab
84    
85        val resolveStkLab = newLabel "resolveStk"
86        val resolveFStkLab = newLabel "resolveFStk"
87        val resolveKindsLab = newLabel "resolveKinds"
88        val gotoCLab = newLabel "gotoC"
89    
90      (* store a gpr argument on the stack *)
91        fun storeStk (arg, ty) =
92                T.STORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArg(ty, arg, argOff), mem)
93    
94    (* store the argument at the stack offset *)    (* store the argument at the stack offset *)
95      fun genStoreStk arg = [      fun genStoreStk arg ty = [
96             T.DEFINE chooseStkLab,             T.DEFINE resolveStkLab,
97             T.STORE(wordTy, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),             storeStk(arg, ty),
98             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
99          ]          ]
100    
101      (* store a fpr argument on the stack *)
102        fun storeFStk (arg, ty) =
103                T.FSTORE(ty, T.ADD (wordTy, spReg, offZippedArg(wordTy, arg, locOff)), offZippedArgF(ty, arg, argOff), mem)
104    
105    (* store the argument at the stack offset *)    (* store the argument at the stack offset *)
106      fun genStoreFStk arg = [      fun genStoreFStk arg ty = [
107             T.DEFINE chooseFStkLab,             T.DEFINE resolveFStkLab,
108             T.FSTORE(64, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTripF(arg, argOff), mem),             storeFStk (arg, ty),
109             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
110          ]          ]
111    
112    (* 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 *)
113      fun genPutGpr arg r = [      fun genPutGpr arg ty r = [
114             T.DEFINE (labelOfReg ("gpr", r)),             T.DEFINE (labelOfReg ("gpr", r)),
115             T.MV (intTy, r, offTrip (arg, argOff)),             T.MV (ty, r, offZippedArg (ty, arg, argOff)),
116             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
117          ]          ]
118    
119    (* 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 *)
120      fun genPutFpr arg r = [      fun genPutFpr arg ty r = [
121             T.DEFINE (labelOfReg ("fpr", r)),             T.DEFINE (labelOfReg ("fpr", r)),
122             T.FMV (64, r, offTripF (arg, argOff)),             T.FMV (ty, r, offZippedArgF (ty, arg, argOff)),
123             T.JMP (T.LABEL interpLab, [])             T.JMP (T.LABEL interpLab, [])
124          ]          ]
125    
126    (* choose the function for loading the register *)    (* resolve the function for loading the register *)
127      fun genChooseReg arg k (r, instrs) = let      fun genResolveReg arg k (r, instrs) = let
128             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))
129             in             in
130                T.BCC(cmp, labelOfReg (k, r)) :: instrs                T.BCC(cmp, labelOfReg (k, r)) :: instrs
131             end             end
132    
133    (* choose registers for loading function arguments *)    (* check the type of the argument *)
134      fun genChooseRegs arg k regs = let      fun checkTy arg (ty, resolveTyLab) =
135             val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)              T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, tyOff), lit ty), resolveTyLab)
136             in  
137                T.DEFINE (chooseRegsLab k) :: instrs    (* resolve the type of the argument *)
138             end      fun genResolveTys arg =
139             T.DEFINE resolveTysLab :: List.map (checkTy arg) storeAtTyLabs
140    (* choose the kind of argument *)  
141      fun genChooseKinds arg = [    (* resolve registers for loading function arguments *)
142             T.DEFINE chooseKindsLab,      fun genResolveRegs arg k regs =
143             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),              T.DEFINE (resolveRegsLab k) ::
144             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),              List.rev (T.JMP(T.LABEL interpLab, []) :: List.foldl (genResolveReg arg k) [] regs)
145             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab),  
146             T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FSTK), chooseFStkLab)    (* resolve the kind of argument *)
147        fun genResolveKinds arg = [
148               T.DEFINE resolveKindsLab,
149               T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit GPR), resolveRegsLab "gpr"),
150               T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit FPR), resolveRegsLab "fpr"),
151               T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit STK), resolveStkLab),
152               T.BCC(T.CMP(wordTy, T.EQ, offZippedArg(wordTy, arg, kindOff), lit FSTK), resolveFStkLab)
153          ]          ]
154    
155      (* end of the argument list *)
156      val NIL = 0      val NIL = 0
157    
158      (* load a value from the argument *)
159      fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)      fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)
160        | 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" ()  
161    
162    (* call the varargs C function *)    (* call the varargs C function *)
163      fun genCallC cFun = let      fun genCallC cFun = let
# Line 131  Line 177 
177             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),
178             T.MV (wordTy, argReg, offArgs args 0),             T.MV (wordTy, argReg, offArgs args 0),
179             T.MV(wordTy, args, offArgs args 1),             T.MV(wordTy, args, offArgs args 1),
180             T.JMP (T.LABEL chooseKindsLab, [])             T.JMP (T.LABEL resolveKindsLab, [])
181          ]          ]
182    
183    (* generate instructions for making a varargs call *)    (* generate instructions for making a varargs call *)
184      fun genVarargs (cFun, args) = let      fun genVarargs (cFun, args) = let
185             val argReg = newReg ()             val argReg = newReg ()
            val interpInstrs = genInterp(args, argReg)  
186             val arg = T.REG(wordTy, argReg)             val arg = T.REG(wordTy, argReg)
187             val ckInstrs = genChooseKinds arg             val resolveGprs = genResolveRegs arg "gpr" gprParams
188             val chooseGprs = genChooseRegs arg "gpr" gprParams             val resolveFprs = genResolveRegs arg "fpr" fprParams
189             val chooseFprs = genChooseRegs arg "fpr" fprParams  (* FIXME *)
190             val loadGprs = List.concat (List.map (genPutGpr arg) gprParams)             val loadGprs = List.concat (List.map (genPutGpr arg wordTy) gprParams)
191             val loadFprs = List.concat (List.map (genPutFpr arg) fprParams)             val loadFprs = List.concat (List.map (genPutFpr arg 64) fprParams)
            val storeStk = genStoreStk arg  
            val storeFStk = genStoreFStk arg  
192             in             in
193                List.concat [                List.concat [
194                   interpInstrs,                   genInterp(args, argReg),
195                   ckInstrs,                   genResolveKinds arg,
                  chooseGprs,  
                  chooseFprs,  
196                   loadGprs,                   loadGprs,
197                   loadFprs,                   loadFprs,
198                   storeStk,                   resolveGprs,
199                   storeFStk,                   resolveFprs,
200    (* FIXME *)
201                     genStoreStk arg wordTy,
202                     genStoreFStk arg 64,
203                   genCallC cFun                   genCallC cFun
204                ]                ]
205             end             end
# Line 168  Line 212 
212        | argToCTy (S _) = CTy.C_PTR        | argToCTy (S _) = CTy.C_PTR
213    
214    (* runtime friendly representation of the C location *)    (* runtime friendly representation of the C location *)
215      fun encodeCLoc (CCall.C_GPR (ty, r)) = (GPR, regToInt r)      fun encodeCLoc (CCall.C_GPR (ty, r)) = (GPR, regToInt r, ty)
216        | encodeCLoc (CCall.C_FPR (ty, r)) = (FPR, regToInt r)        | encodeCLoc (CCall.C_FPR (ty, r)) = (FPR, regToInt r, ty)
217        | encodeCLoc (CCall.C_STK (ty, off)) = (STK, T.I.toInt (wordTy, off))        | encodeCLoc (CCall.C_STK (ty, off)) = (STK, T.I.toInt (wordTy, off), ty)
218        | encodeCLoc (CCall.C_FSTK (ty, off)) = (FSTK, T.I.toInt (wordTy, off))        | encodeCLoc (CCall.C_FSTK (ty, off)) = (FSTK, T.I.toInt (wordTy, off), ty)
219    
220    (* takes a vararg and a location and returns the vararg triplet *)    (* takes a vararg and a location and returns the vararg triplet *)
221      fun varArgTriplet (arg, loc) = let      fun varArg (arg, loc) = let
222             val (k, l) = encodeCLoc loc             val (k, l, ty) = encodeCLoc loc
223             in             in
224               (arg, k, l)               (arg, k, l, ty)
225             end             end
226    
227     (* package the arguments with their locations *)     (* package the arguments with their locations *)
228      fun encodeArgs args = let      fun encodeArgs args = let
229              val argTys = List.map argToCTy args              val argTys = List.map argToCTy args
230              val {argLocs, ...} = CCall.layout {conv="c-call", retTy=CTy.C_void, paramTys=argTys}              val {argLocs, argMem, ...} = CCall.layout {conv="c-call", retTy=CTy.C_void, paramTys=argTys}
231            (* expect single locations, as we do not pass aggregates to vararg functions *)            (* expect single locations, as we do not pass aggregates to vararg functions *)
232              val argLocs = List.map List.hd argLocs              val argLocs = List.map List.hd argLocs
233              in              in
234                  ListPair.mapEq varArgTriplet (args, List.rev argLocs)                  (ListPair.mapEq varArg (args, List.rev argLocs), argMem)
235              end              end
236    
237    end (* AMD64VarargCCallFn *)    end (* VarargCCallFn *)

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

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