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 3049 - (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 :     ) = struct
19 :    
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 :     fun argToCTy (I _) = CTy.C_signed CTy.I_int
27 :     | argToCTy (R _) = CTy.C_double
28 :     | argToCTy (B _) = CTy.C_signed CTy.I_int
29 :     | argToCTy (S _) = CTy.C_PTR
30 :    
31 :     val wordSzB = wordTy div 8
32 :     val mem = T.Region.memory
33 :     val stack = T.Region.stack
34 :    
35 :     fun lit i = T.LI (T.I.fromInt (wordTy, i))
36 :     fun gpr r = T.GPR (T.REG (wordTy, r))
37 :     fun fpr (ty, f) = T.FPR (T.FREG (ty, f))
38 :    
39 :     val GPR = 0
40 :     val FPR = 1
41 :     val STK = 2
42 :    
43 :     val intTy = wordTy
44 :    
45 :     (* offsets into the triplet *)
46 :     val argOff = 0
47 :     val kindOff = 1
48 :     val locOff = 2
49 :    
50 :     fun offTrip (arg, off) = T.LOAD(wordTy, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
51 :     fun offTripF (arg, off) = T.FLOAD(64, T.ADD(wordTy, arg, lit (off*wordSzB)), mem)
52 :    
53 :     val regToInt = CB.physicalRegisterNum
54 :     fun labelOfReg (k, r) = Label.global ("put"^k^Int.toString (regToInt r))
55 :     val labelOfStk = Label.global "stk"
56 :     val interpLab = Label.global "interp"
57 :     fun chooseRegsLab k = Label.global ("chooseRegs"^k)
58 :     val chooseStkLab = Label.global "chooseStk"
59 :     val chooseKindsLab = Label.global "chooseKinds"
60 :    
61 :     (* store the argument at the stack offset *)
62 :     fun genStoreStk arg = [
63 :     T.DEFINE chooseStkLab,
64 :     T.STORE(wordTy, T.ADD (wordTy, spReg, offTrip(arg, locOff)), offTrip(arg, argOff), mem),
65 :     T.JMP (T.LABEL interpLab, [])
66 :     ]
67 :    
68 :     (* place the argument into the parameter register and jump back to the interpreter *)
69 :     fun genPutGpr arg r = [
70 :     T.DEFINE (labelOfReg ("gpr", r)),
71 :     T.MV (intTy, r, offTrip (arg, argOff)),
72 :     T.JMP (T.LABEL interpLab, [])
73 :     ]
74 :    
75 :     (* place the argument into the parameter register and jump back to the interpreter *)
76 :     fun genPutFpr arg r = [
77 :     T.DEFINE (labelOfReg ("fpr", r)),
78 :     T.FMV (64, r, offTripF (arg, argOff)),
79 :     T.JMP (T.LABEL interpLab, [])
80 :     ]
81 :    
82 :     (* choose the function for loading the register *)
83 :     fun genChooseReg arg k (r, instrs) = let
84 :     val cmp = T.CMP(wordTy, T.EQ, offTrip(arg, locOff), lit (regToInt r))
85 :     in
86 :     T.BCC(cmp, labelOfReg (k, r)) :: instrs
87 :     end
88 :    
89 :     (* choose registers for loading function arguments *)
90 :     fun genChooseRegs arg k regs = let
91 :     val instrs = List.rev (List.foldl (genChooseReg arg k) [] regs)
92 :     in
93 :     T.DEFINE (chooseRegsLab k) :: instrs
94 :     end
95 :    
96 :     (* choose the kind of argument *)
97 :     fun genChooseKinds arg = [
98 :     T.DEFINE chooseKindsLab,
99 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit GPR), chooseRegsLab "gpr"),
100 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit FPR), chooseRegsLab "fpr"),
101 :     T.BCC(T.CMP(wordTy, T.EQ, offTrip(arg, kindOff), lit STK), chooseStkLab)
102 :     ]
103 :    
104 :     val NIL = 0
105 :    
106 :     fun offArgs args 0 = T.LOAD (wordTy, T.REG(wordTy, args), mem)
107 :     | offArgs args off = T.LOAD (wordTy, T.ADD (wordTy, T.REG(wordTy, args), lit(off*8)), mem)
108 :    
109 :     val gotoCLab = Label.label "gotoC" ()
110 :    
111 :     (* call the varargs C function *)
112 :     fun genCallC cFun = let
113 :     val defs = List.map gpr CCall.callerSaveRegs @ List.map (fn r => fpr(64, r)) CCall.callerSaveFRegs
114 :     val uses = List.map gpr gprParams @ List.map (fn r => fpr(64, r)) fprParams
115 :     in
116 :     [
117 :     T.DEFINE gotoCLab,
118 :     T.CALL {funct=cFun, targets=[], defs=defs, uses=uses, region=mem, pops=0}
119 :     ]
120 :     end
121 :    
122 :     (* interpreter for varargs *)
123 :     fun genInterp (args, argReg) = [
124 :     T.DEFINE interpLab,
125 :     (* loop through the args *)
126 :     T.BCC (T.CMP(wordTy, T.EQ, T.REG (wordTy, args), lit NIL), gotoCLab),
127 :     T.MV (wordTy, argReg, offArgs args 0),
128 :     T.MV(wordTy, args, offArgs args 1),
129 :     T.JMP (T.LABEL chooseKindsLab, [])
130 :     ]
131 :    
132 :     (* generate instructions for making a varargs call *)
133 :     fun genVarargs (cFun, args) = let
134 :     val argReg = newReg ()
135 :     val interpInstrs = genInterp(args, argReg)
136 :     val arg = T.REG(wordTy, argReg)
137 :     val ckInstrs = genChooseKinds arg
138 :     val chooseGprs = genChooseRegs arg "gpr" gprParams
139 :     val chooseFprs = genChooseRegs arg "fpr" fprParams
140 :     val loadGprs = List.concat (List.map (genPutGpr arg) gprParams)
141 :     val loadFprs = List.concat (List.map (genPutFpr arg) fprParams)
142 :     val storeStk = genStoreStk arg
143 :     in
144 :     List.concat [
145 :     interpInstrs,
146 :     ckInstrs,
147 :     chooseGprs,
148 :     chooseFprs,
149 :     loadGprs,
150 :     loadFprs,
151 :     storeStk,
152 :     genCallC cFun
153 :     ]
154 :     end
155 :    
156 :    
157 :     end (* AMD64VarargCCallFn *)

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