Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/staged-allocation/vararg-c-call-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3051 - (view) (download)

1 : mrainey 3049 (* vararg-c-call-fn.sml
2 :     *
3 :     * Generate MLRISC code that makes a vararg call at runtime. The input to this code is a
4 :     * list of Staged Allocation locations paired with arguments. This code places the arguments
5 :     * in the correct locations.
6 :     *
7 :     * Mike Rainey (mrainey@cs.uchicago.edu)
8 :     *)
9 :    
10 :     functor VarargCCallFn (
11 :     structure T : MLTREE
12 :     structure CCall : C_CALL where T = T
13 :     val gprParams : T.reg list
14 :     val fprParams : T.reg list
15 :     val spReg : T.rexp
16 :     val wordTy : T.ty
17 :     val newReg : 'a -> CellsBasis.cell
18 : mrainey 3051 ) = struct
19 : mrainey 3049
20 :     structure T = T
21 :     structure CB = CellsBasis
22 :     structure CTy = CTypes
23 :    
24 :     datatype argument = I of int | R of real | B of bool | S of string
25 :    
26 :     val mem = T.Region.memory
27 :     val stack = T.Region.stack
28 :    
29 :     fun lit i = T.LI (T.I.fromInt (wordTy, i))
30 :     fun gpr r = T.GPR (T.REG (wordTy, r))
31 :     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
32 :    
33 :     val GPR = 0
34 :     val FPR = 1
35 :     val STK = 2
36 : mrainey 3051 val FSTK = 3
37 : mrainey 3049
38 :     val intTy = wordTy
39 : mrainey 3051 val maxArgSzB = 8
40 : mrainey 3049
41 :     (* offsets into the triplet *)
42 :     val argOff = 0
43 :     val kindOff = 1
44 :     val locOff = 2
45 :    
46 : mrainey 3051 fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*maxArgSzB)), mem)
47 :     fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*maxArgSzB)), mem)
48 : mrainey 3049
49 :     val regToInt = CB.physicalRegisterNum
50 :     fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))
51 :     val labelOfStk = Label.global "stk"
52 :     val interpLab = Label.global "interp"
53 :     fun chooseRegsLab k = Label.global ("chooseRegs"^k)
54 :     val chooseStkLab = Label.global "chooseStk"
55 : mrainey 3051 val chooseFStkLab = Label.global "chooseFStk"
56 : mrainey 3049 val chooseKindsLab = Label.global "chooseKinds"
57 :    
58 :     (* store the argument at the stack offset *)
59 :     fun genStoreStk arg = [
60 :     T.DEFINE chooseStkLab,
61 :     T.STORE(wordTy, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),
62 :     T.JMP (T.LABEL interpLab, [])
63 :     ]
64 :    
65 : mrainey 3051 (* store the argument at the stack offset *)
66 :     fun genStoreFStk arg = [
67 :     T.DEFINE chooseFStkLab,
68 :     T.FSTORE(64, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTripF(arg, argOff), mem),
69 :     T.JMP (T.LABEL interpLab, [])
70 :     ]
71 :    
72 : mrainey 3049 (* place the argument into the parameter register and jump back to the interpreter *)
73 :     fun genPutGpr arg r = [
74 :     T.DEFINE (labelOfReg ("gpr", r)),
75 :     T.MV (intTy, r, offTrip (arg, argOff)),
76 :     T.JMP (T.LABEL interpLab, [])
77 :     ]
78 :    
79 :     (* place the argument into the parameter register and jump back to the interpreter *)
80 :     fun genPutFpr arg r = [
81 :     T.DEFINE (labelOfReg ("fpr", r)),
82 :     T.FMV (64, r, offTripF (arg, argOff)),
83 :     T.JMP (T.LABEL interpLab, [])
84 :     ]
85 :    
86 :     (* choose the function for loading the register *)
87 :     fun genChooseReg arg k (r, instrs) = let
88 :     val cmp = T.CMP(wordTy, T.EQ, offTrip(arg, locOff), lit (regToInt r))
89 :     in
90 :     T.BCC(cmp, labelOfReg (k, r)) :: instrs
91 :     end
92 :    
93 :     (* choose registers for loading function arguments *)
94 :     fun genChooseRegs arg k regs = let
95 :     val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)
96 :     in
97 :     T.DEFINE (chooseRegsLab k) :: instrs
98 :     end
99 :    
100 :     (* choose the kind of argument *)
101 :     fun genChooseKinds arg = [
102 :     T.DEFINE chooseKindsLab,
103 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),
104 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),
105 : mrainey 3051 T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab),
106 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FSTK), chooseFStkLab)
107 : mrainey 3049 ]
108 :    
109 :     val NIL = 0
110 :    
111 :     fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)
112 :     | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*8)), mem)
113 :    
114 :     val gotoCLab = Label.label "gotoC" ()
115 :    
116 :     (* call the varargs C function *)
117 :     fun genCallC cFun = let
118 :     val defs = List.map gpr CCall.callerSaveRegs @ List.map (fn r => fpr(64, r)) CCall.callerSaveFRegs
119 :     val uses = List.map gpr gprParams @ List.map (fn r => fpr(64, r)) fprParams
120 :     in
121 :     [
122 :     T.DEFINE gotoCLab,
123 :     T.CALL {funct=cFun, targets=[], defs=defs, uses=uses, region=mem, pops=0}
124 :     ]
125 :     end
126 :    
127 :     (* interpreter for varargs *)
128 :     fun genInterp (args, argReg) = [
129 :     T.DEFINE interpLab,
130 :     (* loop through the args *)
131 :     T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),
132 :     T.MV (wordTy, argReg, offArgs args 0),
133 :     T.MV(wordTy, args, offArgs args 1),
134 :     T.JMP (T.LABEL chooseKindsLab, [])
135 :     ]
136 :    
137 :     (* generate instructions for making a varargs call *)
138 :     fun genVarargs (cFun, args) = let
139 :     val argReg = newReg ()
140 :     val interpInstrs = genInterp(args, argReg)
141 :     val arg = T.REG(wordTy, argReg)
142 :     val ckInstrs = genChooseKinds arg
143 :     val chooseGprs = genChooseRegs arg "gpr" gprParams
144 :     val chooseFprs = genChooseRegs arg "fpr" fprParams
145 :     val loadGprs = List.concat (List.map (genPutGpr arg) gprParams)
146 :     val loadFprs = List.concat (List.map (genPutFpr arg) fprParams)
147 :     val storeStk = genStoreStk arg
148 : mrainey 3051 val storeFStk = genStoreFStk arg
149 : mrainey 3049 in
150 :     List.concat [
151 :     interpInstrs,
152 :     ckInstrs,
153 :     chooseGprs,
154 :     chooseFprs,
155 :     loadGprs,
156 :     loadFprs,
157 :     storeStk,
158 : mrainey 3051 storeFStk,
159 : mrainey 3049 genCallC cFun
160 :     ]
161 :     end
162 :    
163 : mrainey 3051 val regToInt = CB.physicalRegisterNum
164 : mrainey 3049
165 : mrainey 3051 fun argToCTy (I _) = CTy.C_signed CTy.I_int
166 :     | argToCTy (R _) = CTy.C_double
167 :     | argToCTy (B _) = CTy.C_signed CTy.I_int
168 :     | argToCTy (S _) = CTy.C_PTR
169 :    
170 :     (* runtime friendly representation of the C location *)
171 :     fun encodeCLoc (CCall.C_GPR (ty, r)) = (GPR, regToInt r)
172 :     | encodeCLoc (CCall.C_FPR (ty, r)) = (FPR, regToInt r)
173 :     | encodeCLoc (CCall.C_STK (ty, off)) = (STK, T.I.toInt (wordTy, off))
174 :     | encodeCLoc (CCall.C_FSTK (ty, off)) = (FSTK, T.I.toInt (wordTy, off))
175 :    
176 :     (* takes a vararg and a location and returns the vararg triplet *)
177 :     fun varArgTriplet (arg, loc) = let
178 :     val (k, l) = encodeCLoc loc
179 :     in
180 :     (arg, k, l)
181 :     end
182 :    
183 :     (* package the arguments with their locations *)
184 :     fun encodeArgs args = let
185 :     val argTys = List.map argToCTy args
186 :     val {argLocs, ...} = CCall.layout {conv="c-call", retTy=CTy.C_void, paramTys=argTys}
187 :     (* expect single locations, as we do not pass aggregates to vararg functions *)
188 :     val argLocs = List.map List.hd argLocs
189 :     in
190 :     ListPair.mapEq varArgTriplet (args, List.rev argLocs)
191 :     end
192 :    
193 : mrainey 3049 end (* AMD64VarargCCallFn *)

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