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/llvm/compiler/NewCodeGen/cfg/ppcfg.sml
ViewVC logotype

Annotation of /sml/branches/llvm/compiler/NewCodeGen/cfg/ppcfg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7105 - (view) (download)

1 : jhr 6404 (* ppcfg.sml
2 :     *
3 :     * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure PPCfg : sig
8 :    
9 :     val prCluster : CFG.cluster -> unit
10 :    
11 : jhr 6648 val prCompUnit : CFG.comp_unit -> unit
12 :    
13 : jhr 6404 val expToString : CFG.exp -> string
14 :    
15 : jhr 6666 val numkindToString : CFG_Prim.numkind * int -> string
16 :    
17 :     val paramToString : CFG.param -> string
18 :    
19 : jhr 6404 (* string conversions for various CFG_Prim types *)
20 :     val allocToString : CFG_Prim.alloc -> string
21 :     val arithopToString : CFG_Prim.arithop -> string
22 :     val pureopToString : CFG_Prim.pureop -> string
23 :     val cmpopToString : CFG_Prim.cmpop -> string
24 :     val fcmpopToString : CFG_Prim.fcmpop -> string
25 :     val branchToString : CFG_Prim.branch -> string
26 :     val setterToString : CFG_Prim.setter -> string
27 :     val lookerToString : CFG_Prim.looker -> string
28 :     val arithToString : CFG_Prim.arith -> string
29 :     val pureToString : CFG_Prim.pure -> string
30 :    
31 :     end = struct
32 :    
33 :     structure C = CFG
34 :     structure LV = LambdaVar
35 :     structure P = CFG_Prim
36 :    
37 :     val say = Control.Print.say
38 :    
39 : jhr 6407 val i2s = Int.toString
40 : jhr 6404
41 : jhr 6666 fun numkind2s (P.INT, bits) = ["i", i2s bits]
42 :     | numkind2s (P.FLT, bits) = ["f", i2s bits]
43 : jhr 6407
44 : jhr 6666 val numkindToString = String.concat o numkind2s
45 :    
46 : jhr 6415 val cmpopToString = ArithOps.cmpopToString
47 : jhr 6404 val fcmpopToString = PPCps.fcmpopToString
48 :    
49 : jhr 6452 fun arithopToString oper = (case oper
50 :     of P.IADD => "IADD"
51 :     | P.ISUB => "ISUB"
52 :     | P.IMUL => "IMUL"
53 :     | P.IDIV => "IDIV"
54 :     | P.IREM => "IREM"
55 :     (* end case *))
56 :    
57 : jhr 6415 fun branchToString oper = (case oper
58 :     of P.CMP{oper, signed, sz} => concat[
59 :     cmpopToString oper, if signed then "_i" else "_u",
60 :     Int.toString sz
61 :     ]
62 :     | P.FCMP{oper, sz} => concat[fcmpopToString oper, "_f", Int.toString sz]
63 :     | P.FSGN sz => concat["f", Int.toString sz, "sgn"]
64 :     | P.PEQL => "peql"
65 :     | P.PNEQ => "pneq"
66 : jhr 6648 | P.LIMIT n => concat["needGC(", Word.fmt StringCvt.DEC n, ")"]
67 : jhr 6415 (* end case *))
68 : jhr 6404
69 : jhr 6415 fun allocToString (P.RECORD{desc, mut=false}) =
70 :     concat["record[0x", IntInf.fmt StringCvt.HEX desc, "]"]
71 :     | allocToString (P.RECORD{desc, mut=true}) =
72 :     concat["mut_record[0x", IntInf.fmt StringCvt.HEX desc, "]"]
73 : jhr 6663 | allocToString (P.RAW_RECORD{desc, ...}) = concat[
74 :     "raw_record[0x", IntInf.fmt StringCvt.HEX desc, "]"
75 :     ]
76 : jhr 6415 | allocToString (P.RAW_ALLOC{desc, align, len}) = concat(
77 :     "raw_" :: i2s align :: "_alloc[" ::
78 :     (case desc
79 :     of SOME d => ["0x", IntInf.fmt StringCvt.HEX d, ";"]
80 :     | _ => []
81 :     (* end case *)) @ [i2s len, "]"])
82 :    
83 : jhr 6404 fun setterToString P.UNBOXED_UPDATE = "unboxedupdate"
84 :     | setterToString P.UPDATE = "update"
85 :     | setterToString P.UNBOXED_ASSIGN = "unboxedassign"
86 :     | setterToString P.ASSIGN = "assign"
87 : jhr 6407 | setterToString (P.RAW_UPDATE{kind, sz}) =
88 : jhr 6666 concat("update_" :: numkind2s(kind, sz))
89 : jhr 6415 | setterToString (P.RAW_STORE{kind, sz}) =
90 : jhr 6666 concat("store_" :: numkind2s(kind, sz))
91 : jhr 6415 | setterToString P.SET_HDLR = "sethdlr"
92 :     | setterToString P.SET_VAR = "setvar"
93 : jhr 6404
94 :     fun lookerToString P.DEREF = "!"
95 : jhr 6407 | lookerToString P.SUBSCRIPT = "array_sub"
96 :     | lookerToString (P.RAW_SUBSCRIPT{kind, sz}) =
97 : jhr 6666 concat("array_sub_" :: numkind2s(kind, sz))
98 : jhr 6569 | lookerToString (P.RAW_LOAD{kind, sz}) =
99 : jhr 6666 concat("load_" :: numkind2s(kind, sz))
100 : jhr 6415 | lookerToString P.GET_HDLR = "gethdlr"
101 :     | lookerToString P.GET_VAR = "getvar"
102 : jhr 6404
103 : jhr 6407 fun cvtParams (prefix, from, to) =
104 :     concat[prefix, "_", i2s from, "_to_", i2s to]
105 :    
106 :     fun arithToString (P.ARITH{oper, sz}) = arithopToString oper ^ i2s sz
107 : jhr 6418 | arithToString (P.REAL_TO_INT{mode, from, to}) = let
108 :     fun toS prefix = concat[prefix, i2s from, "_i", i2s to]
109 :     in
110 :     case mode
111 :     of P.TO_NEAREST => toS "round_f"
112 :     | P.TO_NEGINF => toS "floor_f"
113 :     | P.TO_POSINF => toS "ceil_f"
114 :     | P.TO_ZERO => toS "trunc_f"
115 :     (* end case *)
116 :     end
117 : jhr 6404
118 : jhr 6407 fun pureopToString rator = (case rator
119 : jhr 6415 of P.ADD => "add"
120 :     | P.SUB => "sub"
121 :     | P.SMUL => "smul"
122 :     | P.SDIV => "sdiv"
123 :     | P.SREM => "srem"
124 :     | P.UMUL => "umul"
125 :     | P.UDIV => "udiv"
126 :     | P.UREM => "urem"
127 :     | P.LSHIFT => "lshift"
128 :     | P.RSHIFT => "rshift"
129 :     | P.RSHIFTL => "rshiftl"
130 :     | P.ORB => "orb"
131 :     | P.XORB => "xorb"
132 :     | P.ANDB => "andb"
133 :     | P.FADD => "fadd"
134 :     | P.FSUB => "fsub"
135 :     | P.FMUL => "fmul"
136 :     | P.FDIV => "fdiv"
137 :     | P.FNEG => "fneg"
138 :     | P.FABS => "fabs"
139 :     | P.FSQRT => "fsqrt"
140 : jhr 7105 | P.FCOPYSIGN => "fcopysign"
141 : jhr 6407 (* end case *))
142 :    
143 :     fun pureToString (P.PURE_ARITH{oper, sz}) = pureopToString oper ^ i2s sz
144 : jhr 6415 | pureToString (P.EXTEND{signed=true, from, to}) =
145 :     cvtParams ("sign_extend_", from, to)
146 :     | pureToString (P.EXTEND{signed=false, from, to}) =
147 :     cvtParams ("zero_extend_", from, to)
148 : jhr 6735 | pureToString (P.TRUNC{from, to}) = cvtParams ("trunc", from, to)
149 : jhr 6407 | pureToString (P.INT_TO_REAL{from, to}) = cvtParams ("real", from, to)
150 :     | pureToString P.PURE_SUBSCRIPT = "vector_sub"
151 : jhr 6404 | pureToString (P.PURE_RAW_SUBSCRIPT{kind, sz}) =
152 : jhr 6666 concat("vector_sub_" :: numkind2s(kind, sz))
153 :     | pureToString (P.RAW_SELECT{kind, sz, offset}) =
154 :     concat("select_" :: numkind2s(kind, sz) @ ["@", i2s offset])
155 : jhr 6404
156 : jhr 6407 fun space n = say(CharVector.tabulate(n, fn _ => #" "))
157 : jhr 6404
158 :     fun expToString e = (case e
159 : jhr 6653 of C.VAR{name} => LV.lvarName name
160 :     | C.LABEL{name} => "L_" ^ LV.lvarName name
161 : jhr 6569 | C.NUM{iv, sz} =>
162 : jhr 6407 concat["(i", i2s sz, ")", IntInf.toString iv]
163 : jhr 6653 | C.LOOKER{oper, args} => appToS(lookerToString oper, args)
164 :     | C.PURE{oper, args} => appToS(pureToString oper, args)
165 :     | C.SELECT{idx, arg} => appToS("#" ^ i2s idx, [arg])
166 :     | C.OFFSET{idx, arg} => appToS("@" ^ i2s idx, [arg])
167 : jhr 6404 (* end case *))
168 :    
169 :     and appToS (prefix, es) = String.concat[
170 :     prefix, "(", String.concatWithMap "," expToString es, ")"
171 :     ]
172 :    
173 :     fun sayv x = say(LV.lvarName x)
174 :    
175 :     fun sayList sayItem [] = say "()"
176 :     | sayList sayItem [item] = (say "("; sayItem item; say ")")
177 :     | sayList sayItem (fst::rest) = (
178 :     say "("; sayItem fst;
179 :     List.app (fn item => (say ","; sayItem item)) rest;
180 :     say ")")
181 :    
182 : jhr 6407 fun sayTy cty = say(CFGUtil.tyToString cty)
183 : jhr 6404
184 : jhr 6666 fun paramToString {name, ty} = concat[LV.lvarName name, ":", CFGUtil.tyToString ty]
185 :    
186 :     fun sayParam param = say (paramToString param)
187 : jhr 6426 fun sayArg (e, ty) = (say(expToString e); say ":"; sayTy ty)
188 : jhr 6407
189 : jhr 6426 fun sayArgs ([], []) = say "()"
190 :     | sayArgs (arg::args, ty::tys) = (
191 :     say "("; sayArg (arg, ty);
192 :     ListPair.app (fn arg => (say ","; sayArg arg)) (args, tys);
193 :     say ")")
194 : jhr 6653 | sayArgs _ = raise Match
195 : jhr 6426
196 : jhr 6404 fun prStm n = let
197 : jhr 6426 fun sayExp e = say(expToString e)
198 : jhr 6659 fun sayApp (prefix, args) = (say(appToS(prefix, args)))
199 : jhr 6648 fun sayBr (P.LIMIT 0w0, []) = say "needsGC"
200 :     | sayBr (oper as P.LIMIT _, []) = say(branchToString oper)
201 : jhr 6653 | sayBr (oper, args) = sayApp (branchToString oper, args)
202 : jhr 6404 fun pr stm = (
203 :     space n;
204 :     case stm
205 : jhr 6407 of C.LET(e, x, stm) => (
206 : jhr 6415 say(expToString e); say " -> "; sayParam x; say "\n"; pr stm)
207 : jhr 6407 | C.ALLOC(p as P.RAW_ALLOC _, [], x, stm) => (
208 :     say (allocToString p); say " -> "; sayv x; say "\n"; pr stm)
209 :     | C.ALLOC(p, args, x, stm) => (
210 :     sayApp (allocToString p, args);
211 :     say " -> "; sayv x; say "\n"; pr stm)
212 : jhr 6648 | C.APPLY(f, args, tys) => (
213 : jhr 6426 say "apply "; sayExp f; sayArgs (args, tys); say "\n")
214 : jhr 6648 | C.THROW(f, args, tys) => (
215 : jhr 6426 say "throw "; sayExp f; sayArgs (args, tys); say "\n")
216 : jhr 6663 | C.GOTO(lab, args) => (
217 :     sayApp ("goto L_" ^ LV.lvarName lab, args); say "\n")
218 : jhr 6404 | C.SWITCH(arg, cases) => let
219 :     fun sayCase (i, e) = (
220 : jhr 6407 space n; say "case "; say(i2s i);
221 : jhr 6404 say ":\n"; prStm (n+2) e)
222 :     in
223 :     space n; say "switch ("; say(expToString arg); say ") {\n";
224 :     List.appi sayCase cases;
225 :     space n; say "}\n"
226 :     end
227 : jhr 6415 | C.BRANCH(p, args, 0, stm1, stm2) => (
228 : jhr 6648 say "if "; sayBr (p, args); say " {\n";
229 : jhr 6407 prStm (n+2) stm1;
230 : jhr 6404 space n; say "} else {\n";
231 : jhr 6407 prStm (n+2) stm2;
232 : jhr 6404 space n; say "}\n")
233 : jhr 6415 | C.BRANCH(p, args, prob, stm1, stm2) => (
234 : jhr 6648 say "if "; sayBr (p, args);
235 :     say " { ["; say(Int.toString prob); say "/1000]\n";
236 : jhr 6415 prStm (n+2) stm1;
237 :     space n; say "} else { [";
238 : jhr 6648 say(Int.toString(100-prob)); say "/1000]\n";
239 : jhr 6415 prStm (n+2) stm2;
240 :     space n; say "}\n")
241 : jhr 6404 | C.ARITH(p, args, x, stm) => (
242 : jhr 6407 sayApp (arithToString p, args);
243 : jhr 6415 say " -> "; sayParam x; say "\n"; pr stm)
244 : jhr 6407 | C.SETTER(p, args, stm) => (
245 :     sayApp (setterToString p, args); say "\n"; pr stm)
246 : jhr 6648 | C.CALLGC(roots, newRoots, stm) => (
247 :     sayApp ("callgc", roots);
248 :     say " -> (";
249 :     say (String.concatWithMap "," LV.lvarName newRoots);
250 :     say ")\n";
251 :     pr stm)
252 : jhr 6452 | C.RCC{reentrant, linkage, proto, args, results, live, k} => (
253 :     if reentrant
254 :     then say "reentrant c_call "
255 :     else say "c_call ";
256 :     if linkage = "" then () else (say linkage; say " ");
257 : jhr 6407 sayList (fn e => say(expToString e)) args;
258 :     say " -> "; sayList sayParam results; say "\n";
259 : jhr 6452 (* FIXME: print live set too *)
260 :     pr k)
261 : jhr 6404 (* end case *))
262 :     in
263 : jhr 6407 pr
264 : jhr 6404 end
265 :    
266 : jhr 6648 fun prFrag n (C.Frag{kind, lab, params, body}) = (
267 : jhr 6404 space n;
268 : jhr 6648 case kind
269 :     of C.STD_FUN => say "std_fun"
270 :     | C.STD_CONT => say "std_cont"
271 :     | C.KNOWN_FUN => say "known_fun"
272 :     | C.INTERNAL => say "frag"
273 : jhr 6404 (* end case *);
274 : jhr 6648 say " (L)"; sayv lab; say " "; sayList sayParam params; say " {\n";
275 : jhr 6653 prStm (n+2) body;
276 : jhr 6404 space n; say "}\n")
277 :    
278 : jhr 6650 fun prCluster (C.Cluster{attrs, frags}) = (
279 : jhr 6659 say ("# CLUSTER; align " ^ Int.toString(#alignHP attrs));
280 : jhr 6648 if (#needsBasePtr attrs) then say "; base-ptr" else ();
281 :     if (#hasTrapArith attrs) then say "; overflow" else ();
282 :     if (#hasRCC attrs) then say "; raw-cc" else ();
283 : jhr 6659 say "\n{\n";
284 : jhr 6407 List.app (prFrag 2) frags;
285 : jhr 6404 say "}\n")
286 :    
287 : jhr 6648 fun prCompUnit {srcFile, entry, fns} = (
288 :     say (concat["########## ", srcFile, "\n"]);
289 :     prCluster entry;
290 :     List.app (fn f => (say "#####\n"; prCluster f)) fns;
291 :     say "##########\n")
292 :    
293 : jhr 6404 end

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