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 /sml/branches/idlbasis-devel/src/MLRISC/Tools/MDL/mdl-gen-cells.sml
ViewVC logotype

Annotation of /sml/branches/idlbasis-devel/src/MLRISC/Tools/MDL/mdl-gen-cells.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 859 - (view) (download)

1 : leunga 744 (*
2 :     * Generate the <arch>Cells structure.
3 :     * This structure contains various information about the register
4 :     * properties of the architecture.
5 :     *)
6 :    
7 :     functor MDLGenCells(Comp : MDL_COMPILE) : MDL_GEN_MODULE =
8 :     struct
9 :    
10 :     structure Ast = Comp.Ast
11 :     structure Comp = Comp
12 :     structure R = Comp.Rewriter
13 :    
14 :     open Ast Comp.Util
15 :    
16 :     val NO = R.noRewrite
17 :    
18 :     val SZty = IDty(IDENT([],"sz"))
19 :     val REGISTER_IDty = IDty(IDENT([],"register_id"))
20 :     val showFunTy = FUNty(REGISTER_IDty, STRINGty)
21 :     val showWithSizeFunTy = FUNty(TUPLEty[REGISTER_IDty,SZty], STRINGty)
22 :    
23 :     fun gen md =
24 :     let (* name of the structure *)
25 :     val strName = Comp.strname md "Cells"
26 :     val sigName = Comp.signame md "CELLS"
27 :    
28 :     (* all cell kinds *)
29 :     val cellKinds = Comp.cells md
30 :    
31 :     (* Process *)
32 :     fun process([], r) = r
33 :     | process(CELLdecl{id, from, to, count, ...}::ds, r) =
34 :     let val count = case count of NONE => 0 | SOME c => c
35 :     in from := r;
36 :     to := r + count - 1;
37 :     process(ds, r+count)
38 :     end
39 :    
40 :     val firstPseudo = process(cellKinds, 0)
41 :    
42 :    
43 :     (* all cell kind names *)
44 :     val cellKindNames = map (fn CELLdecl{id, ...} => id) cellKinds
45 :    
46 :     val allCellKindNames = cellKindNames
47 :    
48 :     (* cellkinds that has to be put into the cellset *)
49 :     (* val cellSets = Comp.cellSets md
50 :     val cellSets' = Comp.cellSetsAliases md
51 :    
52 :     val cellSetNames = map (fn CELLdecl{id, ...} => id) cellSets
53 :     *)
54 :    
55 :     val clientDefinedCellKinds =
56 :     List.filter (fn CELLdecl{id, ...} =>
57 :     not(MLRiscDefs.isPredefinedCellKind id)) cellKinds
58 :    
59 :     (* locations *)
60 :     val locations = Comp.locations md
61 :    
62 :    
63 :     (* Functions showXXX *)
64 :     val showFunSig =
65 :     VALSIGdecl(map (fn k => "show"^k) cellKindNames,showFunTy)
66 :     val showWithSizeFunSig =
67 :     VALSIGdecl(map (fn k => "show"^k^"WithSize")
68 :     cellKindNames,showWithSizeFunTy)
69 :     val showWithSizeFuns =
70 :     let fun shift(from, to) e =
71 :     if !from = 0 then e
72 :     else LET([VAL("r",
73 :     IFexp(APP("<=",TUPLEexp[ID "r",INTexp(!to)]),
74 :     APP("-",TUPLEexp[ID "r",INTexp(!from)]),
75 :     ID "r"))],e)
76 :     in FUNdecl(
77 :     map (fn CELLdecl{id, from, to, print, ...} =>
78 :     FUNbind("show"^id^"WithSize",
79 :     [CLAUSE([TUPLEpat[IDpat "r",IDpat "ty"]],
80 :     NONE,
81 :     (APPexp(print, TUPLEexp[ID "r",ID "ty"])))]))
82 :     cellKinds)
83 :     end
84 :    
85 :     val showFuns =
86 :     SEQdecl(map (fn CELLdecl{id, from, to, print, bits, ...} =>
87 :     FUN("show"^id,IDpat "r",
88 :     APP("show"^id^"WithSize",TUPLEexp[ID "r",INTexp bits])))
89 :     cellKinds)
90 :    
91 :     (* Functions addXXX *)
92 :     val addFunTy = FUNty(TUPLEty[REGISTERty,CELLSETty],CELLSETty)
93 :     val addFunSig = VALSIGdecl(map (fn s => "add"^s)
94 :     cellKindNames, addFunTy)
95 :     val addFun = VALdecl
96 :     (map (fn k => VALbind(IDpat("add"^k),
97 :     IDexp(IDENT(["CellSet"],"add"))))
98 :     cellKindNames)
99 :    
100 :     (* Client defined cellkinds *)
101 :     val clientDefinedCellKindsSig =
102 :     VALSIGdecl(map (fn CELLdecl{id, ...} => id) clientDefinedCellKinds,
103 :     IDty(IDENT([],"cellkind")))
104 :     fun createCellKind(CELLdecl{id, nickname, ...}) =
105 :     VALbind(IDpat id,
106 :     APPexp(IDexp(IDENT(["CellsBasis"],"newCellKind")),
107 :     RECORDexp[("name",STRINGexp id),
108 :     ("nickname",STRINGexp nickname)]))
109 :    
110 :     val clientDefinedCellKindsDecl =
111 :     VALdecl(map createCellKind clientDefinedCellKinds)
112 :    
113 :     val None = ID "NONE"
114 :     val newCounter = APP("ref",INTexp 0)
115 :    
116 :    
117 :     val nonAliasedCellKinds =
118 :     List.filter(fn CELLdecl{alias=NONE, ...} => true
119 :     | CELLdecl _ => false) cellKinds
120 :    
121 :     fun kindName k =
122 :     if MLRiscDefs.isPredefinedCellKind k
123 :     then IDexp(IDENT(["CellsBasis"],k))
124 :     else ID k
125 :    
126 :    
127 :     (* Generate descriptor for a cellkind *)
128 :     fun mkDesc(CELLdecl{from, to, id, nickname, defaults, ...}) =
129 :     let val zeroReg =
130 :     List.foldr(fn ((r,LITexp(INTlit 0)),_) => APP("SOME",INTexp r)
131 :     | (_,d) => d) None defaults
132 :     val defaultValues =
133 :     LISTexp(map (fn (r,v) => TUPLEexp[INTexp(r + !from),v])
134 :     defaults, NONE)
135 :    
136 :     val count = Int.max(!to - !from + 1,0)
137 :     val physicalRegs = APP("ref", ID("CellsInternal.array0"))
138 :     val exp =
139 :     APP("CellsInternal.DESC",
140 :     RECORDexp[("low", INTexp(!from)),
141 :     ("high", INTexp(!to)),
142 :     ("kind", kindName id),
143 :     ("defaultValues", defaultValues),
144 :     ("zeroReg", zeroReg),
145 :     ("toString", ID("show"^id)),
146 :     ("toStringWithSize", ID("show"^id^"WithSize")),
147 :     ("counter", newCounter),
148 : blume 859 ("dedicated", newCounter),
149 : leunga 744 ("physicalRegs", physicalRegs)
150 :     ]
151 :     )
152 :     in VALbind(IDpat("desc_"^id), exp)
153 :     end
154 :    
155 :     fun mkKindDesc(CELLdecl{alias=NONE, id, ...}) =
156 :     TUPLEexp[kindName id, ID("desc_"^id)]
157 :     | mkKindDesc(CELLdecl{alias=SOME x, id, ...}) =
158 :     TUPLEexp[kindName id, ID("desc_"^x)]
159 :    
160 :     (* create CellsBasis *)
161 :     val applyCellsCommon =
162 :     STRUCTUREdecl("MyCellsCommon",[],NONE,
163 : leunga 775 APPsexp(IDsexp(IDENT([],"CellsCommon")),
164 : leunga 744 DECLsexp
165 :     [$["exception Cells = "^strName,
166 :     "val firstPseudo = 256"
167 :     ],
168 :     VALdecl(map mkDesc nonAliasedCellKinds),
169 :     VAL("cellKindDescs",LISTexp(map mkKindDesc cellKinds,NONE))
170 :     ]))
171 :    
172 :     (* User defined locations *)
173 :     val locationsSig =
174 :     map (fn LOCbind(id,NONE,_) => VALSIGdecl([id],REGISTERty)
175 :     | LOCbind(id,SOME _,_) =>
176 :     VALSIGdecl([id],FUNty(INTty,REGISTERty)))
177 :     locations
178 :    
179 :     val locationsFun0 =
180 :     VALdecl(map (fn CELLdecl{id, ...} =>
181 :     VALbind(IDpat("Reg"^id),APP("Reg",ID id)))
182 :     cellKinds)
183 :    
184 :     val locationsFun =
185 :     let fun mkLoc e =
186 :     let fun exp _ (LOCexp(id,e,_)) =
187 :     let val CELLdecl{id, ...} = Comp.lookupCellKind md id
188 :     in APP("Reg"^id,e)
189 :     end
190 :     | exp _ e = e
191 :     in #exp(R.rewrite{exp=exp,sexp=NO,decl=NO,ty=NO,pat=NO}) e
192 :     end
193 :     in
194 :     map (fn LOCbind(id,NONE,e) => VAL(id,mkLoc e)
195 :     | LOCbind(id,SOME p,e) =>
196 :     VAL(id,LAMBDAexp[CLAUSE([p],NONE,mkLoc e)]))
197 :     locations
198 :     end
199 :    
200 :     fun set k = ID("set"^k)
201 :    
202 :     (* body of signature *)
203 :     val sigBody =
204 :     [$["include CELLS_COMMON"],
205 :     clientDefinedCellKindsSig,
206 :     showFunSig,
207 :     showWithSizeFunSig,
208 :     SEQdecl locationsSig,
209 :     addFunSig
210 :     ]
211 :    
212 :     (* body of structure *)
213 :     val strBody =
214 :     [$["exception "^strName,
215 :     "fun error msg = MLRiscErrorMsg.error(\""^strName^"\",msg)"
216 :     ],
217 :     showWithSizeFuns,
218 :     showFuns,
219 :     clientDefinedCellKindsDecl,
220 :     applyCellsCommon,
221 :     $["open MyCellsCommon"],
222 :     addFun,
223 :     locationsFun0,
224 :     SEQdecl locationsFun,
225 :     Comp.declOf md "Cells"
226 :     ]
227 :    
228 :     in
229 :     Comp.codegen md "instructions/Cells"
230 :     [Comp.mkSig md "CELLS" sigBody,
231 :     Comp.mkStr md "Cells" sigName strBody]
232 :    
233 :     end
234 :    
235 :     end

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